ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 258|回复: 1

请大神帮忙看看,老是出错,运行时错误 ‘-2147023170’ VBA 800706be

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-7-31 15:31 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Sub AddCommentsToWordALL()

    Dim wbApp As Object  ' Word Application
    Dim wbDoc As Word.Document ' Word Document
    Dim shp As Object     ' Word Shape
    Dim fDialog As Object ' File Dialog
    Dim strFileName As Variant
    Dim i As Integer
    Dim ct As Integer
    Dim obj As Word.InlineShape
    Dim par As Word.Paragraph
    Dim inobj As Object

    ' 创建Word应用程序对象
    Set wbApp = CreateObject("Word.Application")
    wbApp.Visible = True ' 可视化Word应用,以便调试或查看进度

    ' 设置文件对话框
    Set fDialog = wbApp.Application.fileDialog(msoFileDialogFilePicker)

    ' 设置过滤器只显示Word文档
    With fDialog
        .Title = "Select Word Documents"
        .Filters.Clear
        .Filters.Add "Word Documents", "*.doc;*.docx;*.docm"
        .AllowMultiSelect = True
    End With

    ' 显示文件对话框
    If fDialog.Show Then
        For Each strFileName In fDialog.SelectedItems
            ' 打开选定的文档
            Set wbDoc = wbApp.Documents.Open(strFileName)

            ct = wbDoc.InlineShapes.count
            ' 在处理InlineShapes时,找出一行多个图片的情况
            For i = 1 To ct
                If i <= ct Then ' 防止越界
                    Set inobj = wbDoc.InlineShapes(i)
                    If inobj.Type = wdInlineShapePicture Then
                        If i + 1 <= wbDoc.InlineShapes.count Then ' 检查下一个元素是否存在
                            If wbDoc.InlineShapes(i + 1).Type = wdInlineShapePicture Then
                                If inobj.Range.Information(wdVerticalPositionRelativeToPage) = _
                                   wbDoc.InlineShapes(i + 1).Range.Information(wdVerticalPositionRelativeToPage) Then
                                   'On Error GoTo ErrorHandler

                                   Debug.Print "i = " & i; " start = " & inobj.Range.Start; "  End = " & inobj.Range.End
                                   wbDoc.Comments.Add Range:=inobj.Range, Text:="aaaa"
                                End If
                            End If
                        End If
                    End If
                End If



'ErrorHandler:
            'Debug.Print "文件 " & strFileName & " 发生错误: " & Err.Description; " i =" & i
            'Err.Clear
            'Resume Next

            Next i


            ' 关闭文档,保存更改
            wbDoc.Close True
        Next strFileName
    End If

    ' 关闭Word应用程序
    wbApp.Quit

    ' 清理对象引用
    Set wbDoc = Nothing
    Set wbApp = Nothing
    Set fDialog = Nothing

End Sub



我想再Excel中运行,判断word文档中的图片,如果是相邻两张图片在同一行上,则增加一个批注,但是运行到  wbDoc.Comments.Add Range:=inobj.Range, Text:="aaaa",总是报自动化错误,请大神给指导一下

TA的精华主题

TA的得分主题

发表于 2024-7-31 17:12 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
尝试了几次,用selections可以(先把对象选中),
ThisDocument.Comments.Add Selection.Range, "123456"
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-25 15:52 , Processed in 0.031549 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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