excel中对于word中含有不规则表格的操作

athent

工作中需要用excel中的数据合成模板那样的word文档，这个前面的合成工作我已经弄好了，但因为个别地方格式问题，还有就是有些子表格内容不固定，要根据excel内数据来确定表格是几行，所以想了个办法，在需要编辑的位置做上标记，生成完毕后用程序统一进行格式处理，就是把“此行删除”位置的行删除掉，如果是规则的表格都可以实现，但是现在这个模板里表格复杂，找了一些代码都处理不了，求大师帮下忙。

表格是这样的


不规则表格的操作.rar (94.9 KB, 下载次数: 11)

2024-3-26 21:16 上传

点击文件名下载附件

taller

gwjkkkkk

Option Explicit
Sub test()
    Dim ar(), i&, r&, wdApp As Word.Application, strFileName$, strPath$, strSaveName$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "模板.docx"
    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 = New Word.Application
    End If
   
    With wdApp.documents.Open(strFileName)
        strSaveName = strPath & "模板（希望达到的效果）"
        With .Content.Find
            .ClearFormatting
            .Forward = True
            Do While .Execute(FindText:="此行删除") = True
                .Parent.Select
                With wdApp.Selection
                    If .Information(wdWithInTable) = True Then
                        .selectRow
                        r = r + 1
                        ReDim Preserve ar(1 To r)
                        Set ar(r) = .Range
                    End If
                End With
            Loop
        End With
        For i = 1 To UBound(ar)
            ar(i).Rows.Delete
        Next i
        .SaveAs strSaveName
        .Close
    End With
   
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

athent

gwjkkkkk 发表于 2024-3-27 19:56
参与一下。。。

可能是我版本较低，我是wps专业版的vba，代码跑不起来。

athent

taller 发表于 2024-3-27 02:35

谢谢，你的代码跑下来，可以把子表中的删掉，主表中的删不了，运行下来结果是下面图里的样子

我自己又改了下代码，就可以完美运行了，下面是我改的代码


Private Sub CommandButton1_Click()
    ' 定义变量
    Dim objWord As Object
    Dim objDoc
    Dim objTable
    Dim oC
    Dim i As Long, j As Long
    Dim blnDeleteRow As Boolean

    ' 创建Word应用程序对象
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True

    ' 打开指定的Word文档
    Set objDoc = objWord.Documents.Open(ThisWorkbook.Path & "\模板.docx")

    ' 遍历文档中的每个表格
    For Each objTable In objDoc.tables
        ' 从后往前遍历表格的每个单元格
        For i = objTable.Range.Cells.Count To 1 Step -1
            Set oC = objTable.Range.Cells(i)
            'oC.Select
            If Left(oC.Range.Text, 4) = "此行删除" Then
                oC.Range.Rows.Delete
            End If
            If oC.tables.Count > 0 Then
                For j = oC.tables(1).Rows.Count To 1 Step -1
                    Set oCSub = oC.tables(1).Columns(1).Cells(j)
                    'oCSub.Select
                    If Left(oCSub.Range.Text, 4) = "此行删除" Then
                        oCSub.Range.Rows.Delete
                    End If
                Next j
            End If
        Next
    Next objTable

    ' 保存并关闭文档
    objDoc.Save
    objDoc.Close

    ' 退出Word应用程序
    objWord.Quit

    ' 释放对象
    Set objTable = Nothing
    Set objDoc = Nothing
    Set objWord = Nothing
End Sub

gwjkkkkk

athent 发表于 2024-3-28 19:58
可能是我版本较低，我是wps专业版的vba，代码跑不起来。

我没有wps，你可参考这贴
https://club.excelhome.net/forum ... ead&tid=1682387

athent

taller 发表于 2024-3-27 02:35

谢谢，可以完美处理不规则表中的子表格，这段代码还没法处理主表中的删除项，运行下来是下图的情况

后来我改了下代码就可以完美处理了
不过如果子表格也是不规则的表就要出错，我继续啃下代码，看能不能自己搞定。

athent

taller 发表于 2024-3-27 02:35

谢谢，可以完美处理不规则表中的子表格，这段代码还没法处理主表中的删除项，运行下来是下图的情况

后来我改了下代码就可以完美处理了
不过如果子表格也是不规则的表就要出错，我继续啃下代码，看能不能自己搞定。

taller