Question

如何将图片和图片文件名字按照时间顺序，通过vba直接插入到word中，我下边有代码，只是插入格式不符合。

Sub 插入图片() '此代码功能将选中的图片插入到word中
Dim MyDialog As FileDialog, GetStr As String
On Error Resume Next '忽略错误
'1、定义一个文件夹选取对话框
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "请选择图片", "*.jpg", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
Selection.TypeParagraph '回车

'3、将图片插入表格
Dim flag As Boolean

flag = True

For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环

If flag = True Then
Selection.InlineShapes.AddPicture FileName:=vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True '插入选择图片

Selection.TypeParagraph '回车确定
Selection.TypeText Text:=Right(vrtSelectedItem, 8) '插入图片
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中显示
GetStr = GetStr & vbCrLf & Right(vrtSelectedItem, 8)
Selection.MoveRight Unit:=wdCell, Count:=1 '光标向下移动
flag = -flag

Else:
Selection.InlineShapes.AddPicture FileName:=vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True '插入选择图片
Selection.TypeParagraph '回车
Selection.TypeText Text:=Right(vrtSelectedItem, 8) '插入文件名
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中显示
GetStr = GetStr & vbCrLf & Right(vrtSelectedItem, 8)

Selection.MoveDown Unit:=wdLine, Count:=1 '光标向下移动
Selection.MoveLeft Unit:=wdCell, Count:=1 '光标向左移动
flag = -flag
End If
Next vrtSelectedItem

End If
End With

ActiveDocument.Save '保存
For Each iShape In ActiveDocument.InlineShapes
iShape.Height = iShape.Height * 0.5
iShape.Width = iShape.Width * 0.5
Next iShape
End Sub
我想把插入的图片和名字一页A4纸排六张，两列三排 图片大小通过
For Each iShape In ActiveDocument.InlineShapes
iShape.Height = iShape.Height * 0.5
iShape.Width = iShape.Width * 0.5
Next iShape

调过正好，每个图片下留空白居中导入对应文件名就可以。这个代码插入后，格式就乱了。向大家讨教下。

Answer 1

什么格式乱了？

追问

我想图片一页6张，两列3排，按那个插入后图片排成一列，图片下边文本标注的图片名称也不是图片文件的全名。

追答

你要先插入一个两列的表格。光标放在第一格，再运行宏。
显示文件全名把
Selection.TypeText Text:=Right(vrtSelectedItem, 8)
改成 Selection.TypeText Text:=vrtSelectedItem

Answer 2

学习了