带有图像名称的 MS Word 标题

Question

下面的代码就像一个魅力。它允许用户选择一个包含 .jpgs 和其他图像类型的文件夹到每页 2 张图像中。当前代码只是将图像标题为“图片”。我需要帮助的是将图像名称作为标题减去.jpg。任何方向都会很棒：

Sub AddPic()
Dim fd As FileDialog
Dim oTbl As Table
Dim oILS As InlineShape
Dim vrtSelectedItem As Variant
  '''''''''''''''
  '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:="Picture"
         For Each vrtSelectedItem In .SelectedItems
             With Selection
                 Set oILS = .InlineShapes.AddPicture(FileName:= _
                 vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
                 Range:=Selection.Range)
                 oILS.Range.InsertCaption Label:="Picture", TitleAutoText:="", Title:="", _
                 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

看来vrtSelectedItem 提供了所需的信息，所以唯一的问题是切断文件扩展名。

这可以通过字符串操作来完成。在下面的代码 sn-p 中，取自问题，确定了文件名中. 的位置，以及文件名的长度。然后使用Mid 函数提取该点左侧的文本。

Dim dotPos as long, lenName as Long
Dim capt as String

 For Each vrtSelectedItem In .SelectedItems
    dotPos = Instr(vrtSelectedItem, ".")
    lenName = Len(vrtSelectedItem)
    capt = Mid(vrtSelectedItem, lenName + (dotPos - 1 - lenName ))
     With Selection
         Set oILS = .InlineShapes.AddPicture(FileName:= _
           vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
           Range:=Selection.Range)
         oILS.Range.InsertCaption Label:="Picture", TitleAutoText:="", Title:=capt, _
           Position:=wdCaptionPositionBelow, ExcludeLabel:=0
         .MoveRight wdCell, 1
     End With
 Next vrtSelectedItem