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

更优雅的方法是使用Range对象，例如Answer to your other question中使用的对象。但是，由于您似乎对Selection比较满意，因此我在下面的代码段中使用了它。

如果既不需要编号也不是标题标签，则使用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

MS Word图片标题宏

1 个答案: