吳乙飛



摘要:文章探討了在Excel/Visio如何使用VBA宏從Excel自動拷貝大量表格到Visio中。隨著Visio在設計工作的大量使用,實現自動化拷貝粘貼的方法可以使設計工作更加有效和有趣。
關鍵詞:Visio 2010; Excel VBA;表格;網絡設計;自動化
近年來,設計工作的畫圖常常使用Visio/Excel,它們都帶有VBA。VBA是Visual Basic for Applications的縮寫,是Visual Basic的一種宏語言,是微軟開發出來在其桌面應用程序中執行通用的自動化任務的編程語言。VBA使用方便,容易推廣> 本文主要討論如何在Visio/Excel中使用宏來簡化設計工作中重復性的勞動。
1 宏的基本概念
宏是將Visio或Excel當中的操作通過錄制或者編寫程序,變成可重復執行的程序。比如,對于反復拷貝或粘貼或計算的工作,不需要每次都手工做同樣的事情,只要運行已經做好的宏,就可達到效果,可以提高工作效率,實現操作自動化。
2 實例分析
2.1 實例的功能
在網絡設計制表中,會把在每個節點的Excel中的某個節點的線纜布放表(見表1),粘貼到Visio(見圖1),網絡設計中節點非常多,可能一個地市有60?150張線纜布放表,如果都是手工粘貼到Visio就非常繁瑣。
這樣的工作簡單重復性高,非常適合使用VBA宏來優化,提高工作效率。筆者對自動粘貼和手工粘貼做了對比,80個局點手工粘貼需要30 min,使用程序以后只需要80 s,效率為原來的30倍。
2.2 Excel中的線纜布放表格式
線纜布放表每列內容和信息如表2所示,每個線纜布放表共16列,其中第一列以序號作為開頭,第15列為節點名稱,作為后面命名名稱的需要,Excel工作表的名稱為線纜布放表匯總,示意用的地市線纜布放匯總表有59個局點信息,共有670行,依次排列,每個節點的線纜布放表以序號開始,以空行分隔結束,每行共有16列。
一個節點的線纜布放如表2所示。程序以序號來測試是否是一個新的局點,并且定義一個新的表格名稱來定義該節點的線纜布放表范圍,名稱就是在Visio中的圖紙名稱,為節點名稱+數據局線纜布放表。
2.3 Visio中的線纜布放表
圖1提供了已經完成的粘貼在Visio中的線纜布放表,每個節點一頁Visio,每個Visio有一個表名,表名為節點名稱+線纜布放表。目標文件如圖1所示。
因此,我們程序的目標就是把Excel中某節點的線纜布放表粘貼到Visio,然后調整好格式大小,并且自動生成表名。
Excel名稱的概念:名稱是一個Excel中有意義的簡略表示法,便于了解單元格引用、常量、公式或表的用途??梢詣摻ê褪褂玫拿Q類型有以下幾種。
(1)已定義名稱。一個表示單元格、區域的單元格、公式或常量值的名稱。您可以創建您自己的已定義的名稱,Microsoft Office Excel有時創建已定義的名稱,比如當設置打印區域時。
(2)表名稱。Excel表格的名稱,Excel表格是存儲在記錄(行)和字段(列)中的有關特定主題的數據集合。
幾個常用的名稱如表3所示。
在程序中使用了表格名稱(NAME)。線纜布放匯總表的表格中有多個節點的線纜布放表,每個線纜布放表開始的標識為A列的內容為序號,我們根據序號找到節點對應的表格名稱范圍,并且把它們加入到名稱管理器中,以該節點名稱加上線纜布放表作來命名,如下面語句所示:
ActiveWorkbook.Names.Add Name:=location-name,RefersTo:=Range(Cells(l, 2), Cells(l,14)).CurrentRegion
其中location_name為15列名稱作為該表格的名稱。
部分線纜布放表的命名名稱如表4所示,出于對設計信息的保密,不列出所有的節點名稱。
2.4 程序邏輯結構
跟程序相關的文件共有3個(見表5)。
程序分成兩部分:第一部分為在Excel中的宏。宏的名稱為線纜布放表命名,主要功能為在名稱管理器中為每個節點定義名稱,規定其范圍,以便于Visio中的宏去找到各個節點的線纜布放表;第二部分為在Visio中的宏,有兩個,一個宏為“線纜布放表粘貼”宏,主要功能為查找線纜布放表.xlsx中的名稱管理器,將名稱管理器中所有的名稱所對應的表格找出來并且粘貼到Visio中,每個表格一個Visio頁面;另外一個宏為adjusttable,主要為調整Visio中的所粘貼線纜布放表的大小,使得它在一個合適的范圍內。
整個程序邏輯如圖2所示。
2.5 Excel中的線纜布放表命名宏
Excel中的宏的名稱為線纜布放表命名。作用是在Excel的表格中給每一張線纜布放表命名。
下面是線纜布放表命名源程序,程序中2?6行為變量申明。srcname為每張線纜布放表的標識符,我們用序號表示,如果是不一樣的表格,可以更改標識符的內容。L為行數,在我們的表格中,最多不超過670行,可以根據大家的情況進行調整。LOCATION_NAME用于標識節點名稱。Location_name_pos是指節點名稱是在序號出現以后多少行,這里設置為3。即在找到表頭行后加上2行的第15列為節點名稱,J為名稱序號,每一個節點有一個表格名稱對應。
程序12?21句為一個循環語句,它尋找“序號”,如果找到,表明一個新的線纜布放表的開始,第14句為計算所在表格的行數,第15句使用了Range(Cells(l,1),Cells(l, 15)).CurrentRegion找出該局點線纜布放表表格范圍,location_name為節點名稱,16句根據該節點線纜布放表的范圍定義表格名稱。
Sub線纜布放表命名。
Dim srcname As String ‘用于區分不同地區的標識
“序號”
Dim 1 As IntegerDim location-name As StringDim location-name-pos As IntegerDim j As Integer
j = l
Sheets(“線纜布放表匯總” ).Selectsrcname 二“序號”location-name-pos = 2table_col-num =15For 1 = 1 To 670
IfCells(l,l).Value= “序號” Thentable row num = Range(Cells(l,1), Cells(l,16)).CurrentRegion. Rows .Count
location-name = Cells(l + location-name-pos , 15).Value & “數^局線纜布放表”
ActiveWorkbook.Names.Add Name:=location-name,RefersTo:=
Range(Cells(l, 1), Cells(l, 15)).CurrentRegion1 = 1 + table_row-num -1
Sheets(“系纜^名稱匯總”).Cells(j,l).Value =location-name
j = j + 1
End If
Next 1
End Sub
2.6 Visio中的宏
程序使用了Visio 2010,不同的Visio版本可以支持的程序略有不同。在這個Vision中有兩個程序。
第一個程序:線纜布放表粘貼到Visio的程序,主要是每個節點增加一個新的Visio頁面,設置好頁面背景,讀取Excel文件,根據Excel中的名稱管理器中的名稱,讀取相關的線纜布放表范圍、內容,并且復制表格以圖元圖片的形式粘貼到Visio頁面中,然后在每頁右下角產生線纜布放表的圖紙名稱,并且調整字體。
下面為線纜布放表粘貼到Visio的程序,程序1?15為變量聲明。其中poslx,posly為x,y坐標,該位置用于設置節點頁面名稱,17?20語句是主要打開同個目錄下面的線纜布放表.xlsx文件,16?45語句為一個循環語句,語句根據線纜布放表.xlsx名稱,27?29是根據名稱增加一個Visio頁面,頁面名稱設置為XX節點線纜布放表。30?40語句是增加一個文本框,加入XX節點線纜布放表名稱,并且設置文本的字符、位置、文本框線型等。語句40?42為線纜布放表相應節點表格拷貝粘貼的功能。45語句把所生成的Visio保存為線纜布放表.vsd文件。
Sub線纜布放表粘貼到Visio的程序。
Dim xlApp As Object
Dim xlname As Name
Dim filepath As String
Dim vsoapplication As Visio.Application
Dim pagename As String
Dim vsoDocument As Visio.Document
Dim vsopages As Visio.Pages
Dim vsoShapel As Visio.Shape
Dim i As Integer
Dim location-num As Integer
Dim poslx As Double
Dim posly As Double
Set vsoapplication = Visio.Application
i = 1
poslx = 30posly = 2
filepath = ActiveDocument.Path
strExcelfile = filepath & “線纜布方文表匯總.xlsx”
‘prepare for the Excel sheet read and write
Set xlApp = GetObject(,“Excel.application”)
Set xlApp = GetObject(strExcelfile)
xlApp. Application-Visible = True
xlApp.Parent.Windows ⑴.Visible = True
location-num = xlApp.Names.Count
Set vsopages = ActiveDocument.Pages
For i = 1 To location num ' LOOP for NAME
Set xlname = xlApp.Names.Item(i)
Set vsopage = vsopages.Addvsopage.Name = xlApp.Names.Item(i).Name
Set vsoShapel = ActivePage.DrawRectangle(poslx,posly, poslx + 5.2, posly + 0.43)
vsoShapel .Text = vsopage .Name
vsopage.BackPage = “A4 模板”
vsoShapel.Cells(“PinX”).Result(69)= poslx
vsoShapel .Cells(“PinY”).Result(69)= posly
vsoShapel.Cells(“width”).Result(69)= 4
vsoShapel.Cells(“height”).Result(69)= 0.43
vsoShapel.Cells(“linecolor”)= visWhite
vsoShapel.Characters.CharProps(visCharacterFont)=216#
vsoShapel .Characters.CharProps(visCharacterSize)=
11#
vsoShapel.Characters.CharProps(visCharacterAsianFont)= 216#
xlnamc.RcfcrsIbRangc.Copy
vsoapplication. ActiveWindow.Page.Paste SpecialvisPasteEMF, False, False
ActiveDocument.DiagramServicesEnabled =DiagramServices
Next i
ActiveDocument.SaveAs(filepath & “線纜布放表.vsd”)
End Sub
第二個程序:adjusttable()自動調整每張Visio中圖片的大小,使得圖片居中,不過長,不過寬,程序如下面程序,
1?17為變量聲明。其中cx為衡量實際粘貼線纜布放表的寬度是指定不能超過的寬度(table_width)的倍數,如果cx>l,則說明實際的粘貼后的寬度過全,cy為衡量實際粘貼線纜布放表的高度是指定不能超過的高度(table_height)的倍數,如果cy>l則說明實際粘貼后的線纜布放表i于高,需要調整。table_centerx,table_centery為線纜布放表的中心位置。該位置用于設置線纜i放表的中心位置,18?38為一個循環語句,語句打開所有粘貼了線纜布放表的頁面,設置粘貼位置,調整大小。調整大小的主要參數為size, size是選擇cx或者cy超過1中比較大的一個值進行設置。22?31語句為設置size值。32?36調整線纜布放表中心點以及大小。
Sub adjusttable()
Dim vsoapplication As Visio.Application
Dim vsopages As Visio.Pages
Dim vsoShapel As Visio.Shape
Dim i As Integer
Dim cx As Double
Dim cy As Double
Dim size As Double
Dim table_width As Double
Dim table_height As Double
Dim table_centerx As Double
Dim table_centery As Double
table_width = 253
table_height =130
table_centerx = 147
table_centery = 117
Set vsoapplication = Visio.Application
i = 1
Set vsopages = ActiveDocument.Pages
For i = 1 To vsopages.Count
Set vsopage = vsopages.Item(i)
If InStr(vsopage.Name, “A4模板”)=0 Then
Set vsoShapel = vsopage. Shapes.Item(2)
cx = vsoShapel.Cells(“width”).Result(70)/ table_width
cy = vsoShapel.Cells(“height”).Result(70)/ page_height
If cx >= cy And cx > 1 Then
size = cx
Elself cy >= cx And cy > 1 Then
size = cy
Else
size = 1
End If
vsoShapel.Cells(“pinx”).Result(70)= table_centerx
vsoShapel .Cells(“piny”).Result(70)= table_centery
vsoShapel.Cells(“width”).Result(70)= vsoShapel.Cells(“width”).Result(70)/ size
vsoShapel.Cells(“height” ).Result(70)= vsoShapel.Cells(“height”).Result(70)/ size
End If
Next i
End Sub
3 結語
隨著通信設計行業的競爭日益激烈,提高工作效率和正確率是一個發展趨勢,對設計工作進行自動化處理可以實現這個目標。對Excel/Visio/CAD/word的編程可以使用在很多地方,希望能在設計行業中更多地引入自動化應用。