带有图像名称的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屋!