(word插入图片自动调整大小)(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

TextBox1.Value = 96

TextBox2.Value = 126

OptionButton1.SetFocus

OptionButton1.Value = 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 TextBox1.Value < 8 Then

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

TextBox1.Value = 7

Else

TextBox1.Value = TextBox1.Value - 1

End If

End Sub

Private Sub SpinButton1_SpinUp()

If TextBox1.Value > 399 Then

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

TextBox1.Value = 400

Else

TextBox1.Value = TextBox1.Value + 1

End If

End Sub

Private Sub SpinButton2_SpinDown()

If TextBox2.Value < 15 Then

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

TextBox2.Value = 14

Else

TextBox2.Value = TextBox2.Value - 1

End If

End Sub

Private Sub SpinButton2_SpinUp()

If TextBox2.Value > 599 Then

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

TextBox2.Value = 601

Else

TextBox2.Value = TextBox2.Value + 1

End If

End Sub

Private Sub ConfirmBtn_Click()

w = TextBox1.Value

h = TextBox2.Value

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

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

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

If OptionButton4.Value = 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() '插入图片并且设置图片的位置

SetPic_w_h_Form1.Show

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

Application.ScreenUpdating = False

curpath = ThisDocument.Path & "\照片素材库\"

Insert_Pic_SerioralNameForm1.Show

If flag = False Then

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

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

For Each s In ActiveDocument.Shapes

s.Delete

Next

Dim shp As Shape

Set shp = ActiveDocument.Shapes.AddPicture(Pic_FilePath, msoTrue, msoFalse)

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

With ActiveDocument

shp.Width = w

shp.Height = h

Select Case pos

Case 1: Delta_TopMargin = IIf(ActiveDocument.PageSetup.TopMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.TopMargin)

Delta_LeftMargin = IIf(ActiveDocument.PageSetup.LeftMargin <> CentimetersToPoints(3.17), CentimetersToPoints(3.17), ActiveDocument.PageSetup.LeftMargin)

shp.Left = 0 - Delta_LeftMargin

shp.Top = 0 - Delta_TopMargin

Case 2: Delta_TopMargin = IIf(ActiveDocument.PageSetup.TopMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.TopMargin)

Delta_RightMargin = IIf(ActiveDocument.PageSetup.RightMargin <> CentimetersToPoints(3.17), CentimetersToPoints(3.17), ActiveDocument.PageSetup.RightMargin)

shp.Left = ActiveDocument.PageSetup.PageWidth - Delta_RightMargin - shp.Width

shp.Top = 0 - Delta_TopMargin

Case 3: Delta_BottomMargin = IIf(ActiveDocument.PageSetup.BottomMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.BottomMargin)

Delta_LeftMargin = IIf(ActiveDocument.PageSetup.LeftMargin <> CentimetersToPoints(3.17), CentimetersToPoints(3.17), ActiveDocument.PageSetup.LeftMargin)

shp.Left = 0 - Delta_LeftMargin

shp.Top = ActiveDocument.PageSetup.PageHeight - Delta_BottomMargin - shp.Height

Case 4: Delta_BottomMargin = IIf(ActiveDocument.PageSetup.BottomMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.BottomMargin)

Delta_RightMargin = IIf(ActiveDocument.PageSetup.RightMargin <> CentimetersToPoints(3.17), CentimetersToPoints(3.17), ActiveDocument.PageSetup.RightMargin)

shp.Left = ActiveDocument.PageSetup.PageWidth - Delta_RightMargin - shp.Width

shp.Top = ActiveDocument.PageSetup.PageHeight - Delta_BottomMargin - shp.Height

End Select

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

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

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

'ActiveDocument.PageSetup.PageWidth是页面宽度

'Delta_RightMargin = IIf(ActiveDocument.PageSetup.RightMargin <> CentimetersToPoints(3.17), CentimetersToPoints(3.17), ActiveDocument.PageSetup.RightMargin)

'shp.Left = ActiveDocument.PageSetup.PageWidth - Delta_RightMargin - 96

'shp.Left = ActiveDocument.PageSetup.PageWidth - Delta_RightMargin - shp.Width

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

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

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

'制转为像素点

'Delta_BottomMargin = IIf(ActiveDocument.PageSetup.BottomMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.BottomMargin)

'shp.Top = ActiveDocument.PageSetup.PageHeight - Delta_BottomMargin - shp.Height

'Delta_TopMargin = IIf(ActiveDocument.PageSetup.TopMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.TopMargin)

'shp.Top = CentimetersToPoints(29.7) - Delta_BottomMargin - shp.Height

End With

Application.ScreenUpdating = True

Else

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

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

For Each s In ActiveDocument.Shapes

s.Delete

Next

End If

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

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

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

For Each s In ActiveDocument.Shapes

s.Delete

Next

End If

End Sub

六、界面运行效果截图

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

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

图8 最终插入图片的效果

六、小结

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

curpath = ThisDocument.Path & "\照片素材库\"

Dim shp As Shape

Set shp = ActiveDocument.Shapes.AddPicture(Pic_FilePath, msoTrue, msoFalse)

Set shp = ActiveDocument.Shapes.AddPicture(Pic_FilePath, msoTrue, msoFalse)

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

With ActiveDocument

shp.Width = w

shp.Height = h

Select Case pos

Case 1: Delta_TopMargin = IIf(ActiveDocument.PageSetup.TopMargin <> CentimetersToPoints(2.54), CentimetersToPoints(2.54), ActiveDocument.PageSetup.TopMargin)

Delta_LeftMargin = IIf(ActiveDocument.PageSetup.LeftMargin <> CentimetersToPoints(3.17), CentimetersToPoints(3.17), ActiveDocument.PageSetup.LeftMargin)

shp.Left = 0 - Delta_LeftMargin

shp.Top = 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

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

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