WORD信息复制至EXCEL

zllyyz

请教各位大大、老师（如何用VB将WORD信息复制至EXCEL？如下图）：
WORD：


复制至EXCEL（同行并列直至WORD无相关内容）：

gwjkkkkk

Option Explicit
Sub test()
    Dim ar(), i&, j&, r&, wdApp As Object, strFileName$, strPath$

    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "目录.doc"
    If Dir(strFileName) = "" Then MsgBox "指定的文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = CreateObject("Word.Application")
    End If
   
    With wdApp.documents.Open(strFileName)
         With .Content.Find
            .ClearFormatting
            .Text = "加入收藏夹^p"
            .Forward = True
            Do While .Execute
                r = r + 1
                ReDim Preserve ar(1 To r)
                Set ar(r) = wdApp.ActiveDocument.Range(.Parent.Start, .Parent.End)
            Loop
        End With
        For i = UBound(ar) To 1 Step -1
            If i = 1 Then
                Set ar(i) = .Range(0, ar(i).Start)
            Else
                Set ar(i) = .Range(ar(i - 1).End, ar(i).Start)
            End If
        Next i
        With ActiveSheet
            .Cells.Delete
            .Rows(3).RowHeight = 364.5
            For i = 1 To UBound(ar)
                .Columns(i + 1).ColumnWidth = 40
                ar(i).Copy
                .Cells(2, i + 1).Select
                .Paste
            Next i
        End With
        .Close False
    End With
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

.................

zllyyz

gwjkkkkk 发表于 2024-5-26 14:38
.................

大佬 可否改为对话框选择WORD 文档？？

gwjkkkkk

现在在外面，回去改一下

gwjkkkkk

zllyyz 发表于 2024-5-26 15:40
大佬 可否改为对话框选择WORD 文档？？

简单修改 一下即可。。。

zllyyz

gwjkkkkk 发表于 2024-5-26 20:40
简单修改 一下即可。。。

还涉及剪贴板的调用  可不简单

gwjkkkkk

zllyyz 发表于 2024-5-26 21:33
还涉及剪贴板的调用  可不简单

哈哈这个简单，用api将系统剪贴板清除。。。

zllyyz

gwjkkkkk 发表于 2024-5-26 21:34
哈哈这个简单，用api将系统剪贴板清除。。。

大佬 恳请再次帮忙看下，文本更改了（“*盒^p"）无法将图文信息写入EXCEL（用原来的文本可导入，但是图片的位置一直错位，大小也没法统一），谢谢

gwjkkkkk

zllyyz 发表于 2024-6-3 18:50
大佬 恳请再次帮忙看下，文本更改了（“*盒^p"）无法将图文信息写入EXCEL（用原来的文本可导入，但是图片 ...

文件内容不一样，特征不一样，要改代码。。。