MS Word图片标题宏

Question

该代码的目的是允许最终用户每页放置两张图片。它还具有将照片的最后4个数字作为标题减去“ .extension”（即.jpg）的目的。如何删除照片的自动编号并从下面的代码中删除“ .jpg”（扩展名）？我想出了如何关闭图片标签的方法。

Sub AddPic()
Dim fd As FileDialog
Dim oTbl As Table
Dim oILS As InlineShape
Dim vrtSelectedItem As Variant
Dim dotPos As Long
Dim lenName As Long
Dim capt As String
  '''''''''''''''
  'Add a 1 row 2 column table to take the images
  '''''''''''''''
Set oTbl = Selection.Tables.Add(Selection.Range, 4, 1)
With oTbl
     .AutoFitBehavior (wdAutoFitWindow)
End With
  '''''''''''''''
Set fda = Application.FileDialog(msoFileDialogFilePicker)
With fda
     .Title = "Select image files and click OK"
     .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
     .FilterIndex = 2
     If .Show = -1 Then
         CaptionLabels.Add Name:=" "
 For Each vrtSelectedItem In .SelectedItems
    dotPos = InStr(vrtSelectedItem, ".")
    lenName = Len(vrtSelectedItem)
    capt = Mid(vrtSelectedItem, lenName + (dotPos - 4 - lenName))

     With Selection
         Set oILS = .InlineShapes.AddPicture(FileName:= _
           vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
           Range:=Selection.Range)
         oILS.Range.InsertCaption Label:=" ", Title:=capt, _
           Position:=wdCaptionPositionBelow, ExcludeLabel:=0
         .MoveRight wdCell, 1
     End With
 Next vrtSelectedItem
If Len(oTbl.Rows.Last.Cells(1).Range) = 2 Then oTbl.Rows.Last.Delete
Set fd = Nothing
End If
End With

  '''''''''''''''
For Each pic In ActiveDocument.InlineShapes
     With pic
         .LockAspectRatio = msoFalse
         If .Width > .Height Then ' horizontal
             .Width = InchesToPoints(5.5)
             .Height = InchesToPoints(3.66)

         Else  ' vertical
             .Width = InchesToPoints(5.5)
         End If
     End With
     Next
  '''''''''''''''
Selection.WholeStory
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle
Selection.Font.Color = wdColorBlack
  '''''''''''''''
End Sub

Answer 1

如果既不需要编号也不是标题标签，则使用InsertCaption功能是没有意义的，它专门执行这些操作。相反，只需将文本插入所需的位置（在图片下方）。

代码通过选择图片，向右移动一个字符（按向右箭头键），然后插入文本来完成此操作。请注意，第一个字符是段落标记（按Enter），然后是标题。

“照片的最后4个数字”（我假设是“文件名”的意思是-可以通过将字符串Mid返回限制为四个字符来完成）。 （请参阅已添加的, 4。）

 For Each vrtSelectedItem In .SelectedItems
    dotPos = InStr(vrtSelectedItem, ".")
    lenName = Len(vrtSelectedItem)
    capt = Mid(vrtSelectedItem, lenName + (dotPos - 4 - lenName), 4)

     With Selection
         Set pic = .InlineShapes.AddPicture(fileName:= _
           vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
           Range:=Selection.Range)
        pic.Range.Select
        .MoveRight wdCharacter
        Selection.Text = vbCr & capt
         .MoveRight wdCell, 1
     End With
 Next vrtSelectedItem