请教下word用VBA插入图片

我是小黑屋

在打开事件中插入图片，插入在标题前面，图片居左，标题居中的，希望可以自动调节预设的宽高。
录制了宏，但不行，想请教下各位


下面是希望插入的位置

1224.rar (3.69 KB, 下载次数: 28)

2016-12-26 16:12 上传

点击文件名下载附件

1. Private Sub Document_Open()
   
2. Selection.Find.ClearFormatting
   
3.     With Selection.Find
   
4.         .Text = "生产确认"
   
5.         .Replacement.Text = ""
   
6.         .Forward = True
   
7.         .Wrap = wdFindStop
   
8.         .Format = False
   
9.         .MatchCase = False
   
10.         .MatchWholeWord = False
    
11.         .MatchByte = False
    
12.         .MatchAllWordForms = False
    
13.         .MatchSoundsLike = False
    
14.         .MatchWildcards = True
    
15.     End With
    
16. Do While Selection.Find.Execute
    
17.     '目标事件
    
18.     ActiveWindow.ActivePane.View.Type = wdPrintView
    
19.     With Selection.Range.PageSetup
    
20.         .TopMargin = 36
    
21.         .BottomMargin = 36
    
22.         .LeftMargin = 36
    
23.         .RightMargin = 36
    
24.     End With
    
25. Loop
    
26. 
    
27. '插入的图片路径  D:\LOGO.JPG  插入的图片自动调好大小，宽2，高2.2 。在“生产确认”这4个字前面插入图片，插入后图片居左，文字居中。
    
28. 
    
29. 
    
30. End Sub
    

复制代码

duquancai

就算写了代码，你也不能用，WPS的？

我是小黑屋

duquancai 发表于 2016-12-26 20:56
就算写了代码，你也不能用，WPS的？

找了论坛中这个可以，但是不会修改成直接载入指定路径的版本（即是不打开文件选择夹供选择）

1. Sub 插入图片()
   
2.     Dim myfile As FileDialog
   
3.     Dim myW As Single, myH As Single
   
4.    
   
5.     myW = InputBox("请输入图片宽度，单位：厘米", , 6)
   
6.     myH = InputBox("请输入图片高度，单位：厘米", , 5.5)
   
7.    
   
8.     Set myfile = Application.FileDialog(msoFileDialogFilePicker)
   
9.     With myfile
   
10.          .InitialFileName = "C:"
    
11.             If .Show = -1 Then
    
12.             For Each fn In .SelectedItems
    
13.           Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
    
14.            mypic.Width = CentimetersToPoints(myW)
    
15.            mypic.Height = CentimetersToPoints(myH)
    
16.      Next fn
    
17.           End If
    
18.     End With
    
19.     Set myfile = Nothing
    
20. End Sub
    

复制代码

duquancai

我是小黑屋 发表于 2016-12-26 21:06
找了论坛中这个可以，但是不会修改成直接载入指定路径的版本（即是不打开文件选择夹供选择）

你不会修改，那就将就用呗！呵呵呵

我是小黑屋

duquancai 发表于 2016-12-26 21:15
你不会修改，那就将就用呗！呵呵呵

已完美解决

妍紫

我是小黑屋 发表于 2016-12-26 21:33
已完美解决

楼主能分享一下怎么解决的吗