房地产财务网

 找回密码
 注册新用户

扫一扫,访问微社区

本站推荐

淘宝广告
查看: 264|回复: 0

[word应用] word批量插入某目录下的所有图片及图片名称

[复制链接]
  • TA的每日心情
    奋斗
    7 小时前
  • 签到天数: 948 天

    连续签到: 1 天

    [LV.10]以坛为家III

    发表于 2019-6-4 09:03:05 | 显示全部楼层 |阅读模式
    新建一空白word文档

    2、 按ALT+F11调出开发工具


    3、 点击“宏”,显示宏列表


    输入宏名,如:test

    点击“新建”,然后在Sub test()与 End Sub间输入如下代码:



    1. Sub InsertPic()
    2.     Dim myfile As FileDialog
    3.     Set myfile = Application.FileDialog(msoFileDialogFilePicker)
    4.     With myfile
    5.         .InitialFileName = "c:\10\"
    6.         If .Show = -1 Then
    7.             For Each fn In .SelectedItems

    8.                 Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
    9.                 '按比例调整相片尺寸
    10.                 WidthNum = mypic.Width
    11.                 c = 10         '在此处修改相片宽,单位厘米
    12.                 mypic.Width = c * 28.35
    13.                 mypic.Height = (c * 28.35 / WidthNum) * mypic.Height
    14.                 If Selection.Start = ActiveDocument.Content.End - 1 Then  '如光标在文末
    15.                     Selection.TypeParagraph    '在文末添加一空段
    16.                 Else
    17.                     Selection.MoveDown
    18.                 End If
    19.                 Selection.Text = Basename(fn)    '函数取得文件名
    20.                 Selection.EndKey

    21.                 If Selection.Start = ActiveDocument.Content.End - 1 Then  '如光标在文末
    22.                     Selection.TypeParagraph    '在文末添加一空段
    23.                 Else
    24.                     Selection.MoveDown
    25.                 End If
    26.             Next fn
    27.         Else
    28.         End If
    29.     End With
    30.     Set myfile = Nothing
    31. End Sub

    32. Function Basename(FullPath)    '取得文件名
    33.     Dim x, y
    34.     Dim tmpstring
    35.     tmpstring = FullPath
    36.     x = Len(FullPath)
    37.     For y = x To 1 Step -1
    38.         If Mid(FullPath, y, 1) = "\" Or _
    39.            Mid(FullPath, y, 1) = ":" Or _
    40.            Mid(FullPath, y, 1) = "/" Then
    41.             tmpstring = Mid(FullPath, y + 1)
    42.             Exit For
    43.         End If
    44.     Next
    45.     Basename = Left(tmpstring, Len(tmpstring) - 4)
    46. End Function
    复制代码



    其中:


    修改成你自己的图片所在目录,记得最后必须加上“\”


    4、 保存,返回原来空白的word文档



    点击“宏”,选择“test”,然后点击运行~


    然后,选择你要添加的图片


    5、 接着就是结果



    ---------------------




    房地产财务网助力房地产会计职业成长!

    发表回复

    *滑块验证:
    您需要登录后才可以回帖 登录 | 注册新用户

    本版积分规则

    关闭

    站长推荐上一条 /3 下一条

    快速回复 返回顶部 返回列表