word插入图片

xiangheping

word按图片名顺序插入图片，有多少插入多少，一共是一个月的

xiangheping

3190496160

Sub 图片排版()
Application.ScreenUpdating = False
   Dim Word对象, 当前路径, 导出文件名, 导出路径文件名, i, j
   Dim arr()
   Set Word对象 = CreateObject("Word.Application")
   路径 = ThisWorkbook.Path & "\"
   当前路径 = ThisWorkbook.Path & "\"
   导出文件名 = Format(Date, "yyyymmdd") & "排版文件.docx"
   导出路径文件名 = 当前路径 & "\" & 导出文件名
   ReDim arr(1 To 500, 1 To 1)
   f = Dir(路径 & "*.webp")
    Do While f <> ""
        m = m + 1
        arr(m, 1) = 路径 & f
    f = Dir
    Loop
   FileCopy 当前路径 & "模板.docx", 导出路径文件名
   With Word对象
      .Documents.Open 导出路径文件名
      .Visible = True
      .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '设置位置在正文
      .Selection.WholeStory '全选
      .Selection.Copy '复制
      If m > 1 Then
          For i = 2 To m '复制页
            .Selection.EndKey 'Unit:=wdStory '光标置于文件尾
            .Selection.InsertBreak Type:=7 'wdPageBreak '分页
            .Selection.PasteAndFormat (wdPasteDefault) '粘贴
         Next i
      End If
     For i = 1 To m '复制页
         tp = arr(i, 1)
         .ActiveDocument.Tables(i).Cell(1, 1).Range.InlineShapes.AddPicture Filename:=tp, LinkToFile:=False, SaveWithDocument:=True '直接插入
         .ActiveDocument.InlineShapes(i).Height = 550 '调整图片高度
    Next i
    .ActiveDocument.Close
End With
Word对象.Quit
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

word插入图片.rar (243.23 KB, 下载次数: 40)

2023-4-16 14:23 上传

点击文件名下载附件

xiangheping

3190496160 发表于 2023-4-16 14:23

谢谢，怎么让图片不变形

xiangheping

3190496160 发表于 2023-4-16 14:23

谢谢，怎么让图片不变形

3190496160

xiangheping 发表于 2023-4-16 16:07
谢谢，怎么让图片不变形

不明白你说的不变形什么什么意思？？

chzsh

   .ActiveDocument.InlineShapes(i).Height = 550 '调整图片高度
调整550

xiangheping

明白了，谢谢，能让图片到word的第二列吗

xiangheping

3190496160 发表于 2023-4-16 14:23

感谢大佬帮忙，图片名称有按顺序排的，我想让图片按顺序插入，现在插入的顺序从1，然后到10了，能帮忙修改下吗，谢谢