点击这里查看首页

WORD批量插入图片和文件名


来源:网络整理
发布时间:2019-11-12 10:42:00
查看次数:

内容提要:因为需要,找了两个VBA代码。


另一个
Sub InsertPic()
    Dim myfile As FileDialog
    Set myfile = Application.FileDialog(msoFileDialogFilePicker)
    With myfile
        .InitialFileName = "F:"
        If .Show = -1 Then
            For Each fn In .SelectedItems

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

                If Selection.Start = ActiveDocument.Content.End - 1 Then  '如光标在文末
                    Selection.TypeParagraph    '在文末添加一空段
                Else
                    Selection.MoveDown
                End If
            Next fn
        Else
        End If
    End With
    Set myfile = Nothing
End Sub

Function Basename(FullPath)    '取得文件名
    Dim x, y
    Dim tmpstring
    tmpstring = FullPath
    x = Len(FullPath)
    For y = x To 1 Step -1
        If Mid(FullPath, y, 1) = "" Or _
           Mid(FullPath, y, 1) = ":" Or _
           Mid(FullPath, y, 1) = "/" Then
            tmpstring = Mid(FullPath, y + 1)
            Exit For
        End If
    Next
    Basename = Left(tmpstring, Len(tmpstring) - 4)

End Function


转载自:http://club.excelhome.net/forum.php?mod=viewthread&tid=778982&page=1#pid5315103

第1页 第2页

相关文章
·BIos密码权限设置05-25
·一分钟彻底清除电脑中的垃圾10-11
·磁带转录成MP3操作方法 09-23
·我的电脑图标不见了怎么办?10-29
·EXCEL表格如何删除零值03-29
·WDS无线组网、无线桥接的应用01-13
·出于安全原因,Firefox 取消了该请求03-22
·教培网网上培训快速及格技巧05-04
·内网穿透工具ngrok09-10
·视频加速脚本TimerHooker (计时器掌控者)06-17
最新文章
·一列数据轻松转换成多行多列02-05
·MPC-HC如何加速播放不变音调?01-06
·利用打印机迁移功能实现三个步骤快速批量安装所有网10-27
·视频号视频的四种下载方法07-07
·Win10系统开机启动文件夹在哪里?04-16
·十秒免工具激活windows 1002-25
·批量替换word文档中的第一行作为文件的文件名06-21
·自动对一个文件夹下的N个word文件批量执行一个宏06-21
·Win10电脑开机启动慢?教你只需三步,电脑开机速度快06-11
·连接打印机时需要输入用户名密码怎么办?05-15
阅读排行