利用VBA編程實現從EXCEL表到AUTOCAD表轉換

一、前言

---- Microsoft Excel 軟件具有十分強大的制表、表格計算等功能，是普通人員常用的制表工具。可以通過其內嵌的VBA語言可以控制Microsoft Excel 的整個操作過程。

---- AutoCAD是由AutoDesk公司的工程繪圖軟件，是CAD市場的主流產品，功能十分強大，是工程制圖人員常用的軟件之一。AutoDesk公司從R14版以后，為其提供了VBA語言接口。

---- 在工程制圖中，常常需要在圖中插入繪制表格，一般有兩種方法。其一，是利用剪貼板，將Microsoft Excel表格拷貝至剪貼板中，然后打開AutoCAD文件，再將剪貼板中的文件粘貼至所需位置。這種方法十分簡單，但有其固有的缺點。①在保存文件必須將.xls和.dwg文件保存在一起，一旦缺少excel環境，則再對表格繼續修改。②同時打開多個表格操作，需要占據較大的內存空間。③文件體積變得很大，表格有時在.dwg文件中以圖標形式顯示，不便于觀察。

---- 第二種方法，即利用Microsoft Excel、AutoCAD都提供的VBA功能，編制程序進行轉換，將Microsoft Excel表格按原來樣子轉換，即把Microsoft Excel表格中的文字和線條信息全部讀取出來，在AutoCAD文件里按照一一對應的方式寫出來，確保轉換后的表格與原表格一致。這樣徹底避免了前種方法的缺點，便于表格內容編輯。本文著重介紹此方法。

---- 二、表格轉換工作機理分析及具體實現方法

---- 1．表格轉換工作機理分析

---- 在制表過程中，經常遇到兩個概念，表和方格。

---- 在Microsoft Excel中，與表對應的對象是工作表（Sheet或Worksheet）,與每一個表格方格相對應的對象是單元格區域（range），它可以僅包括一個單元格（cell）,也可以由多個單元格合并而成。

---- 在AutoCAD中，沒有與表對應的對象，但表可以理解由若干條線和文字對象組合而成。

---- 根據上述分析，可以發現如下的轉換方法：

---- 讀取Microsoft Excel文件中的最小對象----單元格區域(range)的主要信息---線條和文字，然后在AutoCAD文件里在指定圖層、位置畫線條，書寫文字。通過循環，遍歷所有單元格區域(range),邊讀邊寫，最終完成表格的轉換。轉換過程中，保持線條、文字及其相關屬性不發生改變。

---- 下面就轉換工作的兩個主要對象表格線條和表格文字進行討論。

---- 2、表格線條的轉換

---- Microsoft Excel 中內嵌的VBA為我們獲取Excel文件信息提供了極大便利。通常，通過訪問range對象，可以獲得許多信息。訪問分析表格的屬性應從分析range開始。每一個range包括許多對象和屬性,例如,font對象可以返回range的字體信息。通過遍歷,即可獲得整個表格信息。獲取表格信息的目的在于準確地按照位置畫表格線，同時確定文字位置。

---- 在獲取表格信息時，存在一個最佳算法問題。以下就畫線問題為例，闡明問題和解決方法。

---- 假設表格由a(a>=1)行b(b>=1)列組成,x，y為循環變量, 表格完全由單元格組成，由于在每個單元格都有4條邊，讓x從1開始循環到a, 再y從1開始循環到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次，與實際表格的邊數相同，沒有重復讀取。

---- 對合并單元格信息的讀取是個難點。因為如果按照單元格的位置依次讀取，那么由a行b列個單元格（cell）合并而成的單元格區域(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。這樣由多個合并單元格組合后的表格行號、列號有間斷，不連續，無法進行循環讀取信息。筆者通過研究發現，函數address（）和單元格的mergearea屬性可以獲得合并單元格的準確信息。具體方法為：讀取cells(x,y)單元格時，用address()判斷包含cells(x,y)單元格的合并單元格區域c.mergearea的絕對地址,如果前4個字符與cells(x,y) 單元格的地址相同，為cells(x,y)單元格為合并單元格區域最靠上、靠左的那個合并單元格，讀取其4條邊信息，否則不讀取。這樣，徹底避免了重復讀取，同時提高了整個讀取和畫線速度。

---- 在AutoCAD中，線條有多種，考慮能夠方便控制線條屬性，選用了多義線。具體命令如下： RetVal = object.AddLightWeightPolyline(VerticesList)

---- 下面的程序演示表格線條讀取和畫表格線的具體過程。

Sub hxw()
Dim a as interger ‘表格的最大行數
Dim b as interger ‘表格的最大列數
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 =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.Address).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    
	 ‘第一點坐標（數組下標 0 and 1)
                        ptArray(1) = ypoint
                        ptArray(2) = xpoint + xh 
	‘第二點坐標（數組下標 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  
	  ‘第三點坐標（數組下標 0 and 1)
                     ptArray(1) = ypoint - yh
                     ptArray(2) = xpoint  
	‘第四點坐標（數組下標 2 and 3）
                     ptArray(3) = ypoint – yh
                     Lineweight lwployobj,
	 ma.Borders(xlEdgeBottom).Weight
                End If
                If y = 1 Then
                     If ma.Borders(xlEdgeLeft).LineStyle
	 < > xlNone Then
                         ptArray(0) = xpoint    
	  ‘第四點坐標（數組下標 0 and 1)
                         ptArray(1) = ypoint - yh
                         ptArray(2) = xpoint  
	‘第一點坐標（數組下標 2 and 3)
                         ptArray(3) = ypoint
                     End If
 Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight
                End If          
                If ma.Borders(xlEdgeRight).LineStyle
	 < > xlNone Then
                     ptArray(0) = xpoint + xh  
	  ‘第二點坐標（數組下標 0 and 1)
                     ptArray(1) = ypoint
                     ptArray(2) = xpoint + xh 
	‘第三點坐標（數組下標 2 and 3）
                     ptArray(3) = ypoint – yh
                     Lineweight lwployobj,
	 ma.Borders(xlEdgeRight).Weight
                End If		
    Set lwployobj = moSpace.AddLightWeightPolyline(ptArray)	
‘在AutoCAD文件里畫線
    With lwployobj
        .Layer = newlayer.name ‘指定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)
        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
‘下面程序完成列號轉換
Function zh(pp As Integer) As String
    If pp < 26 Then
        zh = Chr(64 + pp)
    Else
        zh = Chr(64 + Int(pp / 26)) + Chr(64 + pp Mod 26)
    End If
End Function
3、表格文字轉換 
---- 表格文字轉換包括表格文字本身轉換和表格文字在表格中位置的轉換兩個部分。 
---- 在AutoCAD中，文字標注的形式有多種，與Microsoft Excel 單元格區
域多行文本內容相對應的是多行文本命令。AutoCAD提供的VBA添加多行文本的命令語句是： 
RetVal = object.AddMText(InsertionPoint, Width, Text)
---- 通過修改RetVal的屬性可以控制表格文字在表格中的位置。 
---- (1)．表格文字本身的轉換 
---- 分析AddMText命令可以得出：表格文字所在位置、文字內容寬度，
文字內容，均可通過此命令來添加。然而表格文字字體，大小，下劃線、
上下腳標，傾斜，加粗等卻不能。
一般的方法是采用修改字體形文件的方法來實現，方法煩瑣，不便于實現，
而且僅對修改過形文件的字體有效。
況且當同一文字塊內的不同文字的字體，大小，下劃線、上下腳標，傾斜，
加粗不同時，使用修改字體形文件的方法也無法實現。
本文介紹一種直接利用Mtext命令提供的方法進行轉換。 
---- 在AddMText命令中，影響文字內容和文字屬性的參數Text。在具體文
字前加上一定的控制符號可以控制文字的文字屬性，具體控制符號可以參閱AutoCAD幫助文件。
例如，{\F宋體；\Q18;\W1.2;ABCDEFG}把“ABCDEFG”設置成宋體、
向右傾斜18度，每個字的寬度是正常寬度1.2倍。 
---- 本程序具體采用的方法是：讀取Microsoft Excel文件某一單元格區域里
的某第j個字符屬性（字體，大小，下劃線、上、下腳標，傾斜，加粗），
讀取Microsoft Excel文件某一單元格區域里的某第j+1個字符屬性，
如果與第j個字符相同，則二者采用同樣的控制符號；若不同，則從第j+1個字符開始，
重復前面的工作。 
Sub wz (? )
Char = RTrim(Left(c.Characters.Caption, 256))
If Char < > Empty Then
?? textStr = ""
?? 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 + 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 Then
???????????????? 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??? 
‘下面函數控制字體本身屬性
Function ForeFontStr(m As Range, u As Integer) As String
??? a1 = "\F" + m.Characters(u, 1).Font.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;", "")? '傾斜
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）.表格中表格文字位置的轉換 
---- 對文字對象的屬性的直接控制來實現，通過with….end with 結構可以很容易地
控制文字的高度、圖層、顏色、書寫方向。
由于Mtext文字提供支持的排列位置分為9種，必須根據Microsoft Excel表格文字的排列
方式加以合適的判定，然后進行轉換。其具體的實現方法詳見下面的程序。 
Sub kz( )
With textObj ‘文字對象
??? .Height = textHgt
??? .Layer = newlayer.Name? ‘設置圖層
??? .Color = acRed????????? ‘設置顏色
??? .DrawingDirection = 1??? ‘設置書寫方向
?? If (ma.VerticalAlignment = 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 = xlCenter _
?????? 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? 'acAttachmentPointTopRight
?? 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.VerticalAlignment = 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 = xlDistributed) _
?????? And ma.HorizontalAlignment = xlRight _
?????? Then .AttachmentPoint = 6 'acAttachmentPointMiddleRight
?? If ma.VerticalAlignment = xlBottom _
?????? And (ma.HorizontalAlignment = xlLeft _
?????? Or ma.HorizontalAlignment = xlGeneral) _
?????? Then .AttachmentPoint = 7? 'acAttachmentPointBottomLeft
? If ma.VerticalAlignment = xlBottom _
?????? And (ma.HorizontalAlignment = xlCenter _
?????? Or ma.HorizontalAlignment = xlJustify _
?????? Or ma.HorizontalAlignment = xlDistributed) _
?????? Then .AttachmentPoint = 8? 'acAttachmentPointBottomCenter
? If ma.VerticalAlignment = xlBottom _
?????? And ma.HorizontalAlignment = xlRight _
?????? Then .AttachmentPoint = 9? 'acAttachmentPointBottomRight
End With
textObj.Update
End Sub
---- 三、功能與特點介紹 
---- 該程序可將Excel表格中的所有單元格全部按原來大小、
風格轉換到AutoCAD文件中來。在轉換過程中，表格線條的轉換和文字轉換是重點。
文字轉換采用了直接利用AddMtext命令提供的屬性進行轉換，
避免了已往修改形文件來進行文字標注的方法，
直接控制表格文字字體、大小、下劃線、上下腳標，傾斜，加粗等，
使每個文字的風格均可以得到很好的控制，極大提高了文字標注的靈活性。 
---- 本程序采用Visual BASIC編制，需要Microsoft Excel 2000和AutoCAD R14運行環境，
編譯后通過。