我在这里有一个很好的算法，可以将一些图片添加到word文档中，并将文件名作为标题提供没有扩展名的文件，对我而言，它非常有用且高效，我分享下面的代码，我推荐它用于大型文档/报告
我需要通过为文档中的图像提供最大高度或宽度来改进此代码，因此它不会占用那么多空间。任何人都可以提示如何快速简单地做到这一点？也许与Shaperange对象？ see VBA-documentation
Option Explicit
Sub VieleFigurenMitTitel()
Dim fd As FileDialog
Dim picName As Variant
Dim TitleText As Variant
Dim oTable As Table
Dim sNoDoc As String
Dim vrtSelectedItem As Variant
Dim fso As New FileSystemObject
If Documents.Count = 0 Then
sNoDoc = MsgBox(" " & _
"No document open!" & vbCr & vbCr & _
"Do you wish to create a new document to hold the images?", _
vbYesNo, "Insert Images")
If sNoDoc = vbYes Then
Documents.Add
Else
Exit Sub
End If
End If
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then
TitleText = InputBox("Abbildung/Figura/Figure", "Namen geben", "Figura")
For Each vrtSelectedItem In .SelectedItems
picName = Split(fso.GetFileName(vrtSelectedItem), ".") 'picName holds the picture name
With Selection
'.ShapeRange.LockAspectRatio msoTrue
.ShapeRange.Width 0.5, msoTrue ' this does not work
.ShapeRange.ScaleHeight 0.5, msoFalse ' this does not work
.InlineShapes.AddPicture fileName:=vrtSelectedItem
Selection.TypeParagraph
Selection.InsertCaption Label:=TitleText, TitleAutoText:="", Title:=": " & picName(0), _
Position:=wdCaptionPositionBelow
Selection.TypeParagraph
End With
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
End Sub