1. 如何在word中打开VBA编辑器？
ALT+F11
2. 如何运行VBA代码？
https://wenku.baidu/view/5b7edafea45177232f60a2e8.html
在代码编辑区输入如下代码：
Sub A()
MsgBox ("hello")
End Sub点击绿色的三角按钮即可运行：
运行结果：
3. 如何在word中录制一段宏？
如果只想进行一些重复性的操作，录制一段宏然后进行修改或者多次运行是一个非常好的办法。
http://www.officezhushou/word2013/4429.html
然而我似乎失败了，之后尝试成功再来补上吧。。。。。。
4. 如何用BVA代码在word中绘制线条和形状
非常详细的图形设置http://blog.sina/s/blog_ae6fe3f8010175sc.html
这个博客介绍了如何画形状和直线，函数曲线。
http://blog.sina/s/blog_557d25460100vh34.html
如何把填充色去掉
http://club.excelhome/thread-1310213-1-1.html
微软官方addShape：
https://msdn.microsoft/en-us/library/office/aa171541(v=office.11).aspx
Sub Shapes()
ActiveDocument.Shapes.AddShape(msoShapeOval, 120, 108, 4, 4).Name = "shp1" '椭圆形
ActiveDocument.Shapes.AddShape(msoShapeOval, 130, 108, 4, 4).Name = "shp2"
ActiveDocument.Shapes.AddShape(msoShapeRectangle, 165.75, 175.5, 197.25, 118.5).Name = "shp3" '矩形
ActiveDocument.Shapes.Range(Array("shp1", "shp2", "shp3")).Group
End Sub然而这里面的单位是磅（point） (1 centimeter = 28.35 points)，我们要如何把单位变成cm或者mm呢？
可以参考微软的官方说明
https://msdn.microsoft/en-us/library/office/aa220346(v=office.11).aspx
ActiveDocument.Shapes.AddShape(msoShapeRectangle, 165.75, 175.5, 197.25, 118.5).Name = "shp3" '随便画一个矩形
With Shapes("shp3")
.Left = CentimetersToPoints(1) 'cm为单位，并且最后只有一个更改后的矩形
.Top = CentimetersToPoints(1)
.Width = CentimetersToPoints(1)
.Height = CentimetersToPoints(1)
.Select '选中
With Selection
.ShapeRange.Fill.Visible = msoFalse '设为透明无填充
End With
End With5.如何用VBA在word中设置页边距
这个资料非常好~
https://wenku.baidu/view/a824437aaef8941ea76e05a0.html
其他参考资料：
https://www.kafan/edu/4122216.html （不知道怎么用）
http://club.excelhome/thread-155191-1-1.html （excel home）
以下是我自己用的代码，放在第一张图那个代码框里面运行即可。
Sub Page()
With ActiveDocument
With .PageSetup
.PaperSize = wdPaperA3 '选择A3纸
.Orientation = wdOrientLandscape '横向
.LeftMargin = CentimetersToPoints(1) '左边距，单位cm
.RightMargin = CentimetersToPoints(1)
.TopMargin = CentimetersToPoints(1)
.BottomMargin = CentimetersToPoints(1)
.SectionStart = wdSectionNewPage '开始新的一页
End With
End With
End Sub6. 如何去下一页或者指定页？
微软官方goto函数：
https://msdn.microsoft/en-us/library/office/aa172261(v=office.11).aspx
一点goto函数的介绍
https://wenku.baidu/view/d7d09fb7f121dd36a32d82f9.html
Application.ActiveWindow.Selection.GoTo wdGoToPage, wdGoToNext, , 3 '去第三页新增一页的代码：
Sub AddPage()
ActiveDocument.Range(0, 0).InsertAfter Chr(12)
End Sub7. 如何使用VBA的循环语句
百度经验：
http://jingyan.baidu/article/6079ad0e83959c28ff86db09.html
最后的代码
（稍微带一点小bug）：
实现的内容大概是生成一个22页的word，然后前21页中每一页画有两个边框和一个点和一个长方形，点和长方形的位置和长方形的宽度由数组决定。
Sub loops()
Dim arrD(1 To 22) '声明数组
Dim arrW(1 To 22)
Dim arrName1()
Dim arrName2()
Dim arrName3()
Dim arrName0()
arrName0 = Array("Rec1", "Rec2", "Rec3", "Rec4", "Rec5", "Rec6", "Rec7", _
"Rec8", "Rec9", "Rec10", "Rec11", "Rec12", "Rec13", "Rec14", _
"Rec15", "Rec16", "Rec17", "Rec18", "Rec19", "Rec20", "Rec21", "Rec22")
arrName1 = Array("Re1", "Re2", "Re3", "Re4", "Re5", "Re6", "Re7", _
"Re8", "Re9", "Re10", "Re11", "Re12", "Re13", "Re14", _
"Re15", "Re16", "Re17", "Re18", "Re19", "Re20", "Re21", "Re22")
arrName2 = Array("L1", "L2", "L3", "L4", "L5", "L6", "L7", _
"L8", "L9", "L10", "L11", "L12", "L13", "L14", _
"L15", "L16", "L17", "L18", "L19", "L20", "L21", "L22")
arrName3 = Array("R1", "R2", "R3", "R4", "R5", "R6", "R7", _
"R8", "R9", "R10", "R11", "R12", "R13", "R14", _
"R15", "R16", "R17", "R18", "R19", "R20", "R21", "R22")
arrD(1) = 5 '似乎只能这样赋值。。。。简直尴尬
arrD(2) = 5
arrD(3) = 5
arrD(4) = 5
arrD(5) = 5
arrD(6) = 5
arrD(7) = 5
arrD(8) = 7.5
arrD(9) = 7.5
arrD(10) = 7.5
arrD(11) = 7.5
arrD(12) = 7.5
arrD(13) = 7.5
arrD(14) = 7.5
arrD(15) = 10
arrD(16) = 10
arrD(17) = 10
arrD(18) = 10
arrD(19) = 10
arrD(20) = 10
arrD(21) = 10
arrD(22) = 5
arrW(1) = 12.5 / 10
arrW(2) = 8.84 / 10
arrW(3) = 6.25 / 10
arrW(4) = 4.42 / 10
arrW(5) = 3.13 / 10
arrW(6) = 2.21 / 10
arrW(7) = 1.56 / 10
arrW(8) = 18.75 / 10
arrW(9) = 13.26 / 10
arrW(10) = 9.38 / 10
arrW(11) = 6.63 / 10
arrW(12) = 4.69 / 10
arrW(13) = 3.31 / 10
arrW(14) = 2.34 / 10
arrW(15) = 25 / 10
arrW(16) = 17.68 / 10
arrW(17) = 12.5 / 10
arrW(18) = 8.84 / 10
arrW(19) = 6.25 / 10
arrW(20) = 4.42 / 10
arrW(21) = 3.13 / 10
arrW(22) = 12.5 / 10
Call setPage
Dim j As Integer
For j = 1 To 21 Step 1
Call AddPage '先把所有的页都生成好，不然原来画好的图就会被覆盖掉
Next
Dim i As Integer
For i = 1 To 22 Step 1
' Goto函数
Application.ActiveWindow.Selection.GoTo wdGoToPage, wdGoToNext, , i
ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
Left:=CentimetersToPoints(-0.12 + 3), Top:=CentimetersToPoints(-0.19 + 0.19), _
Width:=CentimetersToPoints(31), Height:=CentimetersToPoints(30.7)).Name = arrName0(i)
With Shapes(arrName0(i))
.Select
With Selection
.ShapeRange.Fill.Visible = msoFalse
End With
End With
ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
Left:=CentimetersToPoints(0 + 3), Top:=CentimetersToPoints(0 + 0.19), _
Width:=CentimetersToPoints(30.48), Height:=CentimetersToPoints(27.5)).Name = arrName1(i)
With Shapes(arrName1(i))
.Select
With Selection
.ShapeRange.Fill.Visible = msoFalse
End With
End With
ActiveDocument.Shapes.AddShape(msoShapeOval, _
Left:=CentimetersToPoints(15.24 - arrD(i) / 2 - 0.1 + 3), Top:=CentimetersToPoints(14.2875 - 0.1 + 0.19), _
Width:=CentimetersToPoints(0.2), Height:=CentimetersToPoints(0.2)).Name = arrName2(i)
ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
Left:=CentimetersToPoints(15.24 + arrD(i) / 2 - arrW(i) / 2 + 3), Top:=CentimetersToPoints(14.2875 - 5 + 0.19), _
Width:=CentimetersToPoints(arrW(i)), Height:=CentimetersToPoints(10)).Name = arrName3(i)
Next
End Sub
Sub setPage()
With ActiveDocument
With .PageSetup
.PaperSize = wdPaperA3 '选择A3纸
.Orientation = wdOrientLandscape '横向
.LeftMargin = CentimetersToPoints(3.17) '左边距，单位cm
.RightMargin = CentimetersToPoints(3.17)
.TopMargin = CentimetersToPoints(0.2)
.BottomMargin = CentimetersToPoints(1.5)
'.SectionStart = wdSectionNewPage '开始新的一页
End With
End With
End Sub
Sub AddPage()
ActiveDocument.Range(0, 0).InsertAfter Chr(12)
End Sub非常强大的VBA技巧解析：http://club.excelhome/thread-395683-1-1.html
更多推荐
VBA word入门 批量绘制指定位置大小的形状
发布评论