|
要求将文件夹中的图片插入到word中,每行两张图片,每张图片下面是图片的名称。我找了一段代码如下:但是不知道如何修改将图片并列排版。- Function Basename(FullPath) '取得文件名
- Dim x, y
- Dim tmpstring
- tmpstring = FullPath
- x = Len(FullPath)
- For y = x To 1 Step -1
- If Mid(FullPath, y, 1) = "" Or Mid(FullPath, y, 1) = ":" Or Mid(FullPath, y, 1) = "/" Then
- tmpstring = Mid(FullPath, y + 1)
- Exit For
- End If
- Next
- Basename = Left(tmpstring, Len(tmpstring) - 4)
- End Function
- Sub 批量插入图片()
- Dim myfile As FileDialog
- Set myfile = Application.FileDialog(msoFileDialogFilePicker)
- With myfile
- .InitialFileName = "C:\Users\sunwg2\Desktop\照片排版word宏\常减压装置照片" '这里输入你要插入图片的目标文件夹
- If .Show = -1 Then
- For Each FN In .SelectedItems
- Set MyPic = Selection.InlineShapes.AddPicture(FileName:=FN, SaveWithDocument:=True) '按比例调整相片尺寸
- WidthNum = MyPic.Width
- c = 3 '在此处修改相片宽,单位厘米
- MyPic.Width = c * 28.35
- MyPic.Height = (c * 28.35 / WidthNum) * MyPic.Height
-
- If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末
- Selection.TypeParagraph '在文末添加一空段
- Else
- Selection.MoveRight
- End If
-
- Selection.Text = Basename(FN) '这两句移到这里
- Selection.EndKey
- If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末
- Selection.TypeParagraph '在文末添加一空段
- Else
- Selection.MoveRight
- End If
- Next FN
- Else
- End If
- End With
-
- Set myfile = Nothing
- End Sub
复制代码
|
|