利用VBA編程實現(xiàn)從EXCEL表到AUTOCAD表轉(zhuǎn)換

1、利用VBA編程實現(xiàn)從EXCEL表到AUTOCAD表轉(zhuǎn)換             摘要：該程序可將Excel表格中的所有單元格全部按原來大小、風格轉(zhuǎn)換到AutoCAD文件中來。在轉(zhuǎn)換過程中，表格線條的轉(zhuǎn)換和文字轉(zhuǎn)換是重點。文字轉(zhuǎn)換采用了直接利用AddMtext命令提供的屬性進行轉(zhuǎn)換，避免了已往修改形文件來進行文字標注的方法，直接控制表格文字字體、大小、下劃線、上下腳標，傾斜，加粗等，使每個文字的風格均可以得到很好的控制，極大提高了文字標注的靈活性。 關鍵詞：計算機  

2、- 一、前言 - Microsoft Excel 軟件具有十分強大的制表、表格計算等功能，是普通人員常用的制表工具。可以通過其內(nèi)嵌的VBA語言可以控制Microsoft Excel 的整個操作過程。 - AutoCAD是由AutoDesk公司的工程繪圖軟件，是CAD市場的主流產(chǎn)品，功能十分強大，是工程制圖人員常用的軟件之一。AutoDesk公司從R14版以后，為其提供了VBA語言接口。 - 在工程制圖中，常常需要在圖中插入繪制表格，一般有兩種方法。其一，是利用剪貼板，將Microsoft Excel表格拷貝至剪貼板中，然后打開AutoCAD文件，再將剪貼板中的文件粘貼至所需位置。這種方法十分簡

3、單，但有其固有的缺點。在保存文件必須將.xls和.dwg文件保存在一起，一旦缺少excel環(huán)境，則再對表格繼續(xù)修改。同時打開多個表格操作，需要占據(jù)較大的內(nèi)存空間。文件體積變得很大，表格有時在.dwg文件中以圖標形式顯示，不便于觀察。 - 第二種方法，即利用Microsoft Excel、AutoCAD都提供的VBA功能，編制程序進行轉(zhuǎn)換，將Microsoft Excel表格按原來樣子轉(zhuǎn)換，即把Microsoft Excel表格中的文字和線條信息全部讀取出來，在AutoCAD文件里按照一一對應的方式寫出來，確保轉(zhuǎn)換后的表格與原表格一致。這樣徹底避免了前種方法的缺點，便于表格內(nèi)容編輯。本文著重介紹

4、此方法。 - 二、表格轉(zhuǎn)換工作機理分析及具體實現(xiàn)方法 - 1表格轉(zhuǎn)換工作機理分析 - 在制表過程中，經(jīng)常遇到兩個概念，表和方格。 - 在Microsoft Excel中，與表對應的對象是工作表（Sheet或Worksheet）,與每一個表格方格相對應的對象是單元格區(qū)域（range），它可以僅包括一個單元格（cell）,也可以由多個單元格合并而成。 - 在AutoCAD中，沒有與表對應的對象，但表可以理解由若干條線和文字對象組合而成。 - 根據(jù)上述分析，可以發(fā)現(xiàn)如下的轉(zhuǎn)換方法： - 讀取Microsoft Excel文件中的最小對象-單元格區(qū)域(range)的主要信息-線條和文字，然后在Auto

5、CAD文件里在指定圖層、位置畫線條，書寫文字。通過循環(huán)，遍歷所有單元格區(qū)域(range),邊讀邊寫，最終完成表格的轉(zhuǎn)換。轉(zhuǎn)換過程中，保持線條、文字及其相關屬性不發(fā)生改變。 - 下面就轉(zhuǎn)換工作的兩個主要對象表格線條和表格文字進行討論。 - 2、表格線條的轉(zhuǎn)換 - Microsoft Excel 中內(nèi)嵌的VBA為我們獲取Excel文件信息提供了極大便利。通常，通過訪問range對象，可以獲得許多信息。訪問分析表格的屬性應從分析range開始。每一個range包括許多對象和屬性,例如,font對象可以返回range的字體信息。通過遍歷,即可獲得整個表格信息。獲取表格信息的目的在于準確地按照位置畫表格

6、線，同時確定文字位置。 - 在獲取表格信息時，存在一個最佳算法問題。以下就畫線問題為例，闡明問題和解決方法。 - 假設表格由a(a>=1)行b(b>=1)列組成,x，y為循環(huán)變量, 表格完全由單元格組成，由于在每個單元格都有4條邊，讓x從1開始循環(huán)到a, 再y從1開始循環(huán)到b,讀取每個單元格的4條邊,會讀取a*b*4次，重復讀取a*b*2次。當x=1時，讀取上邊；當y=1時讀取,左邊，其余情況讀取右邊，下邊。共讀取a+b+ a*b*2次。以3行4列為例，共讀取3+4+3*4*2=31次，與實際表格的邊數(shù)相同，沒有重復讀取。 - 對合并單元格信息的讀取是個難點。因為如果按照單元格的位

7、置依次讀取，那么由a行b列個單元格（cell）合并而成的單元格區(qū)域(range)僅有4條邊，采用上述計算方法，需要讀取a+b+ a*b*2次，重復讀取a+b+ a*b*2 - 4次。以以3行4列為例，共讀取3+4+3*4*2=31次，重復讀取31 - 4=27次。算法有重復。如果按照行號，列號讀取，合并單元格的行號、列號只有一個，其值為最靠左、靠上的那個單元格的行號、列號。例如，將A2：E5的單元格合并后，其行號為2，列號為A。這樣由多個合并單元格組合后的表格行號、列號有間斷，不連續(xù)，無法進行循環(huán)讀取信息。筆者通過研究發(fā)現(xiàn)，函數(shù)address（）和單元格的mergearea屬性可以獲得合并單元

8、格的準確信息。具體方法為：讀取cells(x,y)單元格時，用address()判斷包含cells(x,y)單元格的合并單元格區(qū)域c.mergearea的絕對地址,如果前4個字符與cells(x,y) 單元格的地址相同，為cells(x,y)單元格為合并單元格區(qū)域最靠上、靠左的那個合并單元格，讀取其4條邊信息，否則不讀取。這樣，徹底避免了重復讀取，同時提高了整個讀取和畫線速度。 -在AutoCAD中，線條有多種，考慮能夠方便控制線條屬性，選用了多義線。具體命令如下：RetVal=object.AddLightWeightPolyline(VerticesList) - 下面的程序演示表格線條讀

9、取和畫表格線的具體過程。 Sub hxw() Dim a as interger 表格的最大行數(shù) Dim b as interger 表格的最大列數(shù) Dim xinit as double 插入點x坐標 Dim yinit as double 插入點y坐標 Dim zinit as double 插入點z坐標 Dim xinsert as double 當前單元格的左上角點的x左標 Dim yinsert as double 當前單元格的左上角點的y左標 Dim ptarray (0 to 2) as double Dim x as integer Dim y as integer For x

10、 =1 to a For y=1 to b Set c = xlsheet.Range(zh(y) + Trim(Str(x) 以行號、列號獲得單元格地址 Set ma = c.MergeArea 求出單元格C的合并單元格地址 If Left(Trim(ma.Address), 4) = Trim(c.Address) Then 假如c.mergearea的絕對地址,如果前4個字符與c單元格的地址相同 xl = "A1:" + ma.Address xh = xlsheet.Range(ma.Address).Width yh = xlsheet.Range(ma.Addr

11、ess).Height Set xlrange = xlsheet.Range(xl) xinsert = xlrange.Width - xh yinsert = xlrange.Height - yh xpoint = xinit + xinsert ypoint = yinit - yinsert If x = 1 Then If ma.Borders(xlEdgeTop).LineStyle <> xlNone Then ptArray(0) = xpoint 第一點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoi

12、nt + xh 第二點坐標（數(shù)組下標 2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight End If If ma.Borders(xlEdgeBottom).LineStyle < > xlNone Then ptArray(0) = xpoint + xh 第三點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint 第四點坐標（數(shù)組下標 2 and 3） ptArray(3) = ypoi

13、nt yh Lineweight lwployobj, ma.Borders(xlEdgeBottom).Weight End If If y = 1 Then If ma.Borders(xlEdgeLeft).LineStyle < > xlNone Then ptArray(0) = xpoint 第四點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint 第一點坐標（數(shù)組下標 2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Bord

14、ers(xlEdgeLeft).Weight End If If ma.Borders(xlEdgeRight).LineStyle < > xlNone Then ptArray(0) = xpoint + xh 第二點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh 第三點坐標（數(shù)組下標 2 and 3） ptArray(3) = ypoint yh Lineweight lwployobj, ma.Borders(xlEdgeRight).Weight End If Set lwployobj = mo

15、Space.AddLightWeightPolyline(ptArray) 在AutoCAD文件里畫線 With lwployobj .Layer = 指定lwployobj所在圖層 .Color = acBlue 指定lwployobj的顏色 End With Lwployobj.Update Next y Next x End Sub 下面程序控制線條粗細 Sub Lineweight(ByVal line As Object, u As Integer) Select Case u Case 1 Call line.SetWidth(0, 0.1, 0.1)

16、Case 2 Call line.SetWidth(0, 0.3, 0.3) Case -4138 Call line.SetWidth(0, 0.5, 0.5) Case 4 Call line.SetWidth(0, 1, 1) Case Else Call line.SetWidth(0, 0.1, 0.1) End Select End Sub 下面程序完成列號轉(zhuǎn)換 Function zh(pp As Integer) As String If pp < 26 Then zh = Chr(64 + pp) Else zh = Chr(64 + Int(pp / 26) + Chr

17、(64 + pp Mod 26) End If End Function - 3、表格文字轉(zhuǎn)換 - 表格文字轉(zhuǎn)換包括表格文字本身轉(zhuǎn)換和表格文字在表格中位置的轉(zhuǎn)換兩個部分。 - 在AutoCAD中，文字標注的形式有多種，與Microsoft Excel 單元格區(qū)域多行文本內(nèi)容相對應的是多行文本命令。AutoCAD提供的VBA添加多行文本的命令語句是： RetVal = object.AddMText(InsertionPoint, Width, Text) - 通過修改RetVal的屬性可以控制表格文字在表格中的位置。 - (1)表格文字本身的轉(zhuǎn)換 - 分析AddMText命令可以得出：表格文字

18、所在位置、文字內(nèi)容寬度，文字內(nèi)容，均可通過此命令來添加。然而表格文字字體，大小，下劃線、上下腳標，傾斜，加粗等卻不能。一般的方法是采用修改字體形文件的方法來實現(xiàn)，方法煩瑣，不便于實現(xiàn)，而且僅對修改過形文件的字體有效。況且當同一文字塊內(nèi)的不同文字的字體，大小，下劃線、上下腳標，傾斜，加粗不同時，使用修改字體形文件的方法也無法實現(xiàn)。本文介紹一種直接利用Mtext命令提供的方法進行轉(zhuǎn)換。 - 在AddMText命令中，影響文字內(nèi)容和文字屬性的參數(shù)Text。在具體文字前加上一定的控制符號可以控制文字的文字屬性，具體控制符號可以參閱AutoCAD幫助文件。例如，F(xiàn)宋體；Q18;W1.2;ABCDEFG把

19、“ABCDEFG”設置成宋體、向右傾斜18度，每個字的寬度是正常寬度1.2倍。 - 本程序具體采用的方法是：讀取Microsoft Excel文件某一單元格區(qū)域里的某第j個字符屬性（字體，大小，下劃線、上、下腳標，傾斜，加粗），讀取Microsoft Excel文件某一單元格區(qū)域里的某第j+1個字符屬性，如果與第j個字符相同，則二者采用同樣的控制符號；若不同，則從第j+1個字符開始，重復前面的工作。 Sub wz ( ) Char = RTrim(Left(c.Characters.Caption, 256) If Char < > Empty Then textStr = &qu

20、ot;" For j = 1 To Len(Char) If c.Characters(j, 1).Font.Underline = xlUnderlineStyleNone Then cpt = c.Characters(j, 1).Caption sonstr = ForeFontStr(c, j) tempstr = "" Do While j + 1 < = Len(Char) sonstr1 = ForeFontStr(c, j + 1) If sonstr1 = sonstr Then j = j + 1 tempstr = tempstr +

21、c.Characters(j, 1).Caption Else Exit Do End If Loop textStr = textStr + "" + sonstr + cpt + tempstr + "" Else cpt = c.Characters(j, 1).Caption sonstr = ForeFontStr(c, j) tempstr = "" Do While j + 1 < = Len(Char) sonstr1 = ForeFontStr(c, j + 1) If sonstr1 = sonstr The

22、n j = j + 1 tempstr = tempstr + c.Characters(j, 1).Caption Else Exit Do End If Loop textStr = textStr + "L" + sonstr + cpt + tempstr + "l" End If Next j End If End Sub 下面函數(shù)控制字體本身屬性 Function ForeFontStr(m As Range, u As Integer) As String a1 = "F" + m.Characters(u, 1).Fo

23、nt.Name + "" 字體 a2 = IIf(m.Characters(u, 1).Font.Superscript = True, "H0.33x;A2;", "") '上腳標 a3 = IIf(m.Characters(u, 1).Font.Subscript = True, "H0.33x;A0;", "") '下腳標 a4 = IIf(m.Characters(u, 1).Font.FontStyle = "傾斜", "Q18;"

24、;, "") '傾斜 a5 = IIf(m.Characters(u, 1).Font.FontStyle = "加粗", "W1.2;", "") '加粗 a6 = IIf(m.Characters(u, 1).Font.FontStyle = "加粗 傾斜", "W1.2;Q18;", "") ' 加粗傾斜 ForeFontStr = a1 + a2 + a3 + a4 + a5 + a6 End Function - （2）.

25、表格中表格文字位置的轉(zhuǎn)換 - 對文字對象的屬性的直接控制來實現(xiàn)，通過with.end with 結(jié)構(gòu)可以很容易地控制文字的高度、圖層、顏色、書寫方向。由于Mtext文字提供支持的排列位置分為9種，必須根據(jù)Microsoft Excel表格文字的排列方式加以合適的判定，然后進行轉(zhuǎn)換。其具體的實現(xiàn)方法詳見下面的程序。 Sub kz( ) With textObj 文字對象 .Height = textHgt .Layer = newlayer.Name 設置圖層 .Color = acRed 設置顏色 .DrawingDirection = 1 設置書寫方向 If (ma.VerticalAlig

26、nment = xlTop _ Or ma.VerticalAlignment = xlGeneral) _ And (ma.HorizontalAlignment = xlLeft _ Or ma.HorizontalAlignment = xlGeneral) _ Then .AttachmentPoint = 1 'acAttachmentPointTopLeft If (ma.VerticalAlignment = xlTop _ Or ma.VerticalAlignment = xlGeneral) _ And (ma.HorizontalAlignment = xlCen

27、ter _ Or ma.HorizontalAlignment = xlJustify _ Or ma.HorizontalAlignment = xlDistributed) _ Then .AttachmentPoint = 2 'acAttachmentPointTopCenter If (ma.VerticalAlignment = xlTop _ Or ma.VerticalAlignment = xlGeneral) _ And ma.HorizontalAlignment = xlRight _ Then .AttachmentPoint = 3 'acAttac

28、hmentPointTopRight If (ma.VerticalAlignment = xlCenter _ Or ma.VerticalAlignment = xlJustify _ Or ma.VerticalAlignment = xlDistributed) _ And (ma.HorizontalAlignment = xlLeft _ Or ma.HorizontalAlignment = xlGeneral) _ Then .AttachmentPoint = 4 'acAttachmentPointMiddleLeft If (ma.VerticalAlignmen

29、t = xlCenter _ Or ma.VerticalAlignment = xlJustify _ Or ma.VerticalAlignment = xlDistributed) _ And (ma.HorizontalAlignment = xlCenter _ Or ma.HorizontalAlignment = xlJustify _ Or ma.HorizontalAlignment = xlDistributed) _ Then .AttachmentPoint = 5 'acAttachmentPointMiddleCenter If (ma.VerticalAlignment = xlCenter _ Or ma.VerticalAlignment = xlJustify _ Or ma.VerticalAlignment