带有图像名称的MS Word标题 [英] MS Word Caption with the Image Name

问题描述

下面的代码就像一个超级字符.它允许用户将包含.jpgs和其他图像类型的文件夹选择为每页2张图像.当前代码仅将图像的标题标记为图片".我需要帮助的是获取图像名称作为标题减去.jpg.任何方向都很好:

The code below works like a charm. It allows the user to pick a folder with .jpgs and other image types into a 2 image per page. The Current code just captions the image as "Picture". What I am needing assistance with is getting the image name as caption minus the .jpg. Any direction would be great:

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

推荐答案

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

It appears vrtSelectedItem provides the information that's required, so the only problem is cutting off the file extension.

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

This can be done by string manipulation. In the code snippet below, taken from the question, the location of the . in the file name is ascertained, as well as the length of the file name. The Mid function is then used to extract the text to the left of that point.

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

这篇关于带有图像名称的MS Word标题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！