作者： 老王

Dim oWord As Object
Call BindWord(True)

Dim oDocument As Object
Set oDocument = oWord.ActiveDocument
Call NameList

Public Sub NameList()
On Error Resume Next
Dim RowsCount, ColsCount As Integer
With oDocument
.Paragraphs(.Paragraphs.Count).Range.Font.Name = “宋体”
.Paragraphs(.Paragraphs.Count).Range.Font.Size = 12
.Paragraphs(.Paragraphs.Count).Range.Font.Bold = False
.Paragraphs(.Paragraphs.Count).Alignment = 1
.Paragraphs(.Paragraphs.Count).Range.Text = “花名册”
RowsCount = 3
ColsCount = 4
.Tables.Add Range:=.Range(Start:=.Range.End – 1, End:=.Range.End), NumRows:=RowsCount, NumColumns:=ColsCount, DefaultTableBehavior:=1, AutoFitBehavior:=2 ‘wdAutoFitFixed = 0 wdAutoFitContent = 1 wdAutoFitWindow = 2
With .Tables(.Tables.Count)
.Range.Cells(1).Range.Text = “姓名”
.Range.Cells(2).Range.Text = “性别”
.Range.Cells(3).Range.Text = “年龄”
.Range.Cells(4).Range.Text = “职称”
.Range.Cells(5).Range.Text = “张三”
.Range.Cells(6).Range.Text = “男”
.Range.Cells(7).Range.Text = “36”
.Range.Cells(8).Range.Text = “工程师”
.Range.Cells(9).Range.Text = “李四”
.Range.Cells(10).Range.Text = “女”
.Range.Cells(11).Range.Text = “28”
.Range.Cells(12).Range.Text = “预算员”
End With
End With
On Error GoTo 0
End Sub

‘绑定 Microsoft Word
Dim oWord As Object ‘Microsoft Word Application 本身
Call BindWord(True)
Dim oDocument As Object ‘Microsoft Word 多文档之一

‘打开并绑定文件 D:/Test.rtf
Set oDocument = oWord.Application.Documents.Open(“D:/Test.rtf”)

‘绑定已经打开文件 Demo.doc
Set oDocument = oWord.Documents.Item(“Demo.doc”)

‘新建文件并绑定
Set oDocument = oWord.Documents.Add

‘绑定已经打开的当前文件
Set oDocument = oWord.ActiveDocument

‘另存文件并指定格式
oDocument.SaveAs “D:/TestBack”, FileFormat:=6 ‘RTF Format

‘退出 Microsoft Word 并释放资源
oWord.Quit
Set oWord = Nothing
Set oDocument = Nothing

Dim oAutoCAD As Object
Call BindAutoCAD(True)

Dim dStartPoint(0 To 2) As Double
Dim dEndPoint(0 To 2) As Double
Dim dCenterPoint(0 To 2) As Double
Dim sTextString As String
Dim dHeight As Double
Dim dRadius As Double

dStartPoint(0) = 10
dStartPoint(1) = 10
dStartPoint(2) = 0
dEndPoint(0) = 100
dEndPoint(1) = 100
dEndPoint(2) = 0
dCenterPoint(0) = 10
dCenterPoint(1) = 10
dCenterPoint(2) = 0
sTextString = “Hello world!”
dHeight = 6
dRadius = 24

Call DrawLine(dStartPoint, dEndPoint)
Call DrawText(sTextString, dStartPoint, dHeight)
Call DrawCircle(dCenterPoint, dRadius)

Public Sub DrawLine(vStartPoint As Variant, vEndPoint As Variant) ‘绘制直线
Dim oLine As Object
Set oLine = oAutoCAD.ActiveDocument.ModelSpace.AddLine(vStartPoint, vEndPoint)
End Function

Public Sub DrawText(sTextString As String, vStartPoint As Variant, vHeight As Variant) ‘写入文本
Dim oText As Object
Set oText = oAutoCAD.ActiveDocument.ModelSpace.AddText(sTextString, vStartPoint, vHeight)
End Function

Public Sub DrawCircle(vCenterPoint As Variant, vRadius As Variant) ‘绘制圆
Dim oCircle As Object
Set oCircle = oAutoCAD.ActiveDocument.ModelSpace.AddCircle(vCenterPoint, vRadius)
End Function

Dim oAutoCAD As Object
Call BindAutoCAD(True)

Dim sLayerName As String
Dim iColor As Integer
Dim sTextStyle As String
Dim iMode As Integer

sLayerName = “平面”
iColor = 1 ‘Red
sTextStyle = “汉字”
iMode = 519 ‘端点 1 + 中点 2 + 圆心 4 + 最近点 512

Call AddLayer(sLayerName, iColor)
Call AddTextStyle(sTextStyleName)
Call SetOSMode(iMode)

Public Sub AddLayer(sLayerName As String, iColor As Integer) ‘增加图层
Dim oLayer As Object
Set oLayer = oAutoCAD.ActiveDocument.Layers.Add(sLayerName)
oLayer.Color = iColor
oAutoCAD.ActiveDocument.ActiveLayer = oLayer
End Function

Public Sub AddTextStyle(sTextStyleName As String) ‘添加或修改字体
Dim oTextStyle As Object
Set oTextStyle = oAutoCAD.ActiveDocument.TextStyles.Add(sTextStyleName)
oTextStyle.BigFontFile = “hztxt.shx”
oTextStyle.FontFile = “romans.shx”
oTextStyle.Height = 8
oTextStyle.Width = 0.6
oAutoCAD.ActiveDocument.ActiveTextStyle = oTextStyle
End Function

Public Sub SetOSMode(ByVal iMode As Integer) ‘设置对象捕捉模式
oDraw.SetVariable “OSMODE”, iMode
‘使用以下位码设置“对象捕捉”的模式(OSNAP mode)：
‘0 NON (无)
‘1 END（端点）
‘2 MID（中点）
‘4 CEN (圆心)
‘8 NOD (节点)
’16 QUA (象限点)
’32 INT（交点）
’64 INS (插入点)
‘128 PER (垂足)
‘256 Tan (切点)
‘512 NEA (最近点)
‘1024 QUI (快速)
‘2048 App (外观交点)
‘4096 EXT (尺寸线)
‘8192 PAR (平行)
‘要指定多个对象捕捉方式，请输入各个位码值之和。
End Sub