|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
代码如下
Sub 每行插入表格n个图()
On Error Resume Next
Application.ScreenUpdating = False
Dim D As FileDialog, a, P As InlineShape, t As Table
If Selection.Information(wdWithInTable) = True Then MsgBox "请将光标置于表格之外!": Exit Sub
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "请选择..."
If .Show = -1 Then
n = 1
M = .SelectedItems.Count
Debug.Print "共有" & M & "个图片"; M
h = IIf(M / n = Int(M / n), 2 * M / n, 2 * (Int(M / n) + 1))
Set t = ActiveDocument.Tables.Add(Selection.Range, h, n)
t.Borders.Enable = True
t.Borders.OutsideLineStyle = wdLineStyleDouble
For Each a In .SelectedItems
B = Split(a, "\")(UBound(Split(a, "\")))
C = Split(B, ".")(0)
Set P = Selection.InlineShapes.AddPicture(FileName:=a, SaveWithDocument:=True)
With P
w = .Width
.Width = Int(220 / n)
.Height = .Width * .Height / w
End With
i = i + 1
Selection.MoveLeft wdCharacter, 1
Selection.MoveDown wdLine, 1
Selection.TypeText C
Selection.Cells(1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '决定了首行居中
Selection.HomeKey
Selection.MoveDown wdLine, -1
Selection.MoveRight wdCharacter, 2
Debug.Print i, n
If i = Val(n) Then
Selection.MoveRight wdCharacter, 1
Selection.Cells(1).Select
Selection.EndKey
Selection.MoveDown wdLine, 1
i = 0
End If
Next
End If
End With
Application.ScreenUpdating = True
End Sub
|
|