【word表格插入图片】妙用VBA实现在Word文档中插入图片并设置其大小、位置

很高兴再次和大家在这里见面。不知道大家有没有尝试在word中VBA的后台环境下，在word前端插入图片。我想大家很少或没有。主要是在word上操作VBA可能会觉得很难！

呵呵，没关系。我现在分享一下我是怎么做的。希望大家喜欢。

好了，下面我们来具体介绍下如何实现的过程吧。

一、在空白的word文档中插入一个ActiveX命令按钮，并在【开发工具】功能选项卡里的属性里将该命令按钮名称设置为“Insert_PicAndJust_Position”，标题Caption为“插入图片并设置其位置”。如下图所示

图1 插入ActiveX按钮并设置属性

二、在设计模式下，立即双击该命令按，输入必要代码：Call Insert_Pic，如下图所示

图2 给该命令按钮添加行为代码

三、准备待插入的素材图片资源。如下图

图3 待用的素材图片资源

四、设计两个窗体并添加各自的行为代码（我是实打实地将源码粘贴给给位哦）

(一)设计进行带插入后图片在文档中的宽、高和位置的窗体

图4 待插入文档中的图片参数设置

代码如下：

Private Sub UserForm_Initialize()

flag = False

Tex = 96

Tex = 126

O

O = True

End Sub

'窗体卸载时响应的操作（后面所有的卸载窗体Unload SetPic_w_h_Form1，都将调用

'下面的窗体卸载关闭事件过程UserForm_QueryClose(Cancel, CloseMode)）

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

flag = True 'True表示窗体卸载关闭

Cancel = False 'Cancel = False表示不取消窗体卸载关闭（即关闭窗体）

End Sub

Private Sub SpinButton1_SpinDown()

If Tex < 8 Then

MsgBox "图片预设宽度不能窄于7(Pixs)" & Chr(10) & "将重置为7(Pixs)", , "提示"

Tex = 7

Else

Tex = Tex - 1

End If

End Sub

Private Sub SpinButton1_SpinUp()

If Tex > 399 Then

MsgBox "图片预设宽度不能宽于400(Pixs)" & Chr(10) & "将重置为400(Pixs)", , "提示"

Tex = 400

Else

Tex = Tex + 1

End If

End Sub

Private Sub SpinButton2_SpinDown()

If Tex < 15 Then

MsgBox "图片预设高度不能低于14(Pixs)" & Chr(10) & "将重置为14(Pixs)", , "提示"

Tex = 14

Else

Tex = Tex - 1

End If

End Sub

Private Sub SpinButton2_SpinUp()

If Tex > 599 Then

MsgBox "图片预设高度不能高于600(Pixs)" & Chr(10) & "将重置为600(Pixs)", , "提示"

Tex = 601

Else

Tex = Tex + 1

End If

End Sub

Private Sub ConfirmBtn_Click()

w = Tex

h = Tex

If O = True Then pos = 1 '选择了左上顶部位置

If O = True Then pos = 2 '选择了右上顶部位置

If O = True Then pos = 3 '选择了左下底部位置

If O = True Then pos = 4 '选择了右下底部位置

Unload SetPic_w_h_Form1 '窗体卸载关闭

flag = False '由于调用了窗体卸载会将flag = False，所以现在必须重置为False

'，以便于模块中的过程好使用flag的窗体假设未关闭的正常状态

End Sub

Private Sub CancelBtn_Click()

Unload SetPic_w_h_Form1 '窗体卸载关闭

End Sub

(二)设计选择插入第几张图片的窗体

图5 选择第几张图片窗体

代码如下：

Private Sub OkBtn_Click()

SN = ComboBox1.Value

Unload Insert_Pic_SerioralNameForm1 '卸载窗体（隐形调用

'UserForm_QueryClose过程，进行卸载）

flag = False '点击确定按钮时表示要生效的执行程序，所以要将flag的值重置为窗

'口未关闭的状态，以方便程序执行下去

End Sub

Private Sub UserForm_Initialize()

ComboBox1.Clear '组合框内容初始化清空

For i = 1 To 32 '组合框的选择项目添加生成

ComboBox1.AddItem i

Next

ComboBox1.Value = 1 '组合框显示的初始值为1

ComboBox1.Style = fmStyleDropDownList '将组合框的设置为只能选择而不能输入

'这里设置属性.Style = fmStyleDropDownList

End Sub

'以下是点击了窗体标题栏的“X”按钮进行的窗体卸载操作

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Cancel = False '不取消窗体卸载关闭，即“关闭且卸载窗体”

flag = True

End Sub

五、插入模块，实现真正的图片位置及大小设定

代码如下：

Public flag As Boolean 'flag为窗体是否卸载关闭状态：

'设定True表示窗体卸载关闭，False表示窗体未卸载关闭

Public w, h, SN, pos As Integer 'pos代表位置

Sub Insert_Pic() '插入图片并且设置图片的位置

Se

If flag = False Then '假设窗体未关闭，则执行下列操作

A = False

curpath = T & "\照片素材库\"

In

If flag = False Then

Pic_FilePath = curpath & "IMAGE (" & SN - 1 & ").jpg"

'清除原先所有的图片，初始化页面

For Each s In Ac

s.Delete

Next

Dim shp As Shape

Set shp = Ac.AddPicture(Pic_FilePath, msoTrue, msoFalse)

'以下是将新插入的图片设置固定宽高，然后将其置于页面的右下部对齐

With ActiveDocument

= w

= h

Select Case pos

Case 1: Delta_TopMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

Delta_LeftMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

= 0 - Delta_LeftMargin

= 0 - Delta_TopMargin

Case 2: Delta_TopMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

Delta_RightMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

= Ac - Delta_RightMargin -

= 0 - Delta_TopMargin

Case 3: Delta_BottomMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

Delta_LeftMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

= 0 - Delta_LeftMargin

= Ac - Delta_BottomMargin -

Case 4: Delta_BottomMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

Delta_RightMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

= Ac - Delta_RightMargin -

= Ac - Delta_BottomMargin -

End Select

'设置新插入的图片的左边位置（由A4页面的宽、高参数获取进行图片左部位置的设置

'方式一：Ac页面的宽度为像数点，然后减去右边距，

'再减去得到图片的左部位置,这里原定宽度为96像素点），其中

'Ac是页面宽度

'Delta_RightMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

' = Ac - Delta_RightMargin - 96

' = Ac - Delta_RightMargin -

'设置新插入图片的顶部位置（由A4页面的宽21厘米、高29.7厘米参数对图片顶部位置的设置

'方式二：CentimetersToPoints(126)强制转换为像数点，然后减去下边距，再减去图片高

'度126得到图片的顶部位置），其中CentimetersToPoin)是将页面高度29.7厘米强

'制转为像素点

'Delta_BottomMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

' = Ac - Delta_BottomMargin -

'Delta_TopMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

' = CentimetersToPoin) - Delta_BottomMargin -

End With

A = True

Else

MsgBox "未选择任何图片的序号，退出", vbInformation, "提示"

'未选择任何图片序号，清除原先所有的图片，初始化页面

For Each s In Ac

s.Delete

Next

End If

Else '否则，窗体已经关闭，给个提示，不做任何操作

MsgBox "未作任何选择操作，退出！", vbInformation, "提示"

'未作任何选择操作，清除原先所有的图片，初始化页面

For Each s In Ac

s.Delete

Next

End If

End Sub

六、界面运行效果截图

图6 待插入的图片大小位置选择

图7 选择需要插入的第几张图片

图8 最终插入图片的效果

六、小结

1、插入图片并设置的关键技术代码

curpath = T & "\照片素材库\"

Dim shp As Shape

Set shp = Ac.AddPicture(Pic_FilePath, msoTrue, msoFalse)

Set shp = Ac.AddPicture(Pic_FilePath, msoTrue, msoFalse)

'以下是将新插入的图片设置固定宽高，然后将其置于页面的右下部对齐

With ActiveDocument

= w

= h

Select Case pos

Case 1: Delta_TopMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

Delta_LeftMargin = II <> CentimetersToPoin), CentimetersToPoin), Ac)

= 0 - Delta_LeftMargin

= 0 - Delta_TopMargin

┊

2、定义了全局的公有变量用于回传数据

Public flag As Boolean 'flag为窗体是否卸载关闭状态：

'设定True表示窗体卸载关闭，False表示窗体未卸载关闭

Public w, h, SN, pos As Integer 'pos代表位置

3、重新定义窗体按<X>按钮或取消按钮的响应事件

'窗体卸载时响应的操作（后面所有的卸载窗体Unload SetPic_w_h_Form1，都将调用

'下面的窗体卸载关闭事件过程UserForm_QueryClose(Cancel, CloseMode)）

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

flag = True 'True表示窗体卸载关闭

Cancel = False 'Cancel = False表示不取消窗体卸载关闭（即关闭窗体）

End Sub

好了，全部实现都给予大家了，大家可以试着去做做看，有不清楚的给我留言哦!

最好，还是希望大家多多关注和点评，谢谢！