求大神帮忙改改，让这个表格应用的更顺畅一些能跑的下去

想吃想喝想睡觉

报错：在过程 Test 中发生错误:无效的过程调用或参数

Option Explicit

Private Sub Test()
    ' 声明变量
    Dim WordApp As Object ' Word 应用程序对象
    Dim V ' 用于存储 Excel 工作表中的数据
    Dim P As String, Pn As String ' 文件路径变量
    Dim Y As Long, X As Long, Col As Long, LastRow As Long ' 循环计数器
    Dim FileExtPos As Integer ' 文件扩展名的位置

    ' 错误处理
    On Error GoTo ErrorHandler

    ' 检查日期，如果当前日期超过 2023 年 6 月 1 日，则退出
    If Date > DateSerial(2025, 6, 1) Then Exit Sub

    ' 操作当前工作表
    With Me
        ' 如果 A1 单元格为空，则设置为 ASCII 码 28 对应的字符
        If Len(.Range("A1").Value) = 0 Then .Range("A1").Value = Chr$(28)
        ' 获取当前工作表中已使用的区域数据
        V = .UsedRange
    End With

    ' 获取数据的最后一行
    LastRow = UBound(V, 1)

    ' 启动 Word 应用程序
    Set WordApp = CreateObject("Word.Application")
    ' WordApp.Visible = True ' 调试时可取消注释，显示 Word 应用程序

    ' 遍历第 23 列及后续列
    For Col = 23 To UBound(V, 2)
        ' 如果模板文件名为空，则退出循环
        If Len(Trim(V(2, Col))) = 0 Then Exit For

        ' 构建模板文件路径
        P = ThisWorkbook.Path & "\" & V(2, Col)

        ' 检查模板文件是否存在，如果不存在则提示并退出
        If Not FileExists(P) Then
            MsgBox "文件不存在：" & vbCrLf & P, vbOKOnly + vbExclamation, "错误"
            Exit Sub
        End If

        ' 查找文件扩展名的位置
        FileExtPos = InStrRev(V(2, Col), ".")
        ' 如果文件名中没有扩展名，则退出循环
        If FileExtPos = 0 Then
            MsgBox "文件名中没有扩展名：" & V(2, Col), vbExclamation, "错误"
            Exit For
        End If

        ' 遍历数据行（从第 4 行开始）
        For Y = 4 To LastRow
            ' 如果新文件的名称部分为空，则退出循环
            If Len(Trim(V(Y, 2))) = 0 Then Exit For

            ' 生成目标文件名，保留原文件名并添加 V(Y, 2) 的值
            Pn = ThisWorkbook.Path & "\" & Left(V(2, Col), FileExtPos - 1) & "_" & V(Y, 2) & Mid(V(2, Col), FileExtPos)

            ' 检查路径长度是否超过限制
            If Len(Pn) > 260 Then
                MsgBox "文件路径过长：" & Pn, vbExclamation, "错误"
                Exit Sub
            End If

            ' 如果目标文件已存在，则删除
            If FileExists(Pn) Then
                On Error Resume Next
                Kill Pn
                On Error GoTo ErrorHandler
            End If

            ' 复制模板文件到新路径
            On Error Resume Next
            FileCopy P, Pn
            On Error GoTo ErrorHandler

            ' 在调试窗口中输出当前处理的文件名
            Debug.Print "正在处理文件：" & Pn
            ' 更新状态栏，显示当前操作
            Application.StatusBar = "正在写入: " & Pn

            ' 处理 Word 文件
            With WordApp
                ' 打开新创建的 Word 文档
                On Error Resume Next
                .Documents.Open fileName:=Pn
                On Error GoTo ErrorHandler

                ' 遍历第 2 到 21 列，替换 Word 文档中的内容
                For X = 2 To 21
                    If Len(Trim(V(2, X))) > 0 Then
                        V(Y, X) = CStr(V(Y, X))
                        .ActiveDocument.Content.Find.Execute FindText:=V(2, X), ReplaceWith:=V(Y, X), Replace:=2
                    End If
                Next X

                ' 保存并关闭文档
                .ActiveDocument.Save
                .ActiveDocument.Close
            End With
        Next Y
    Next Col

    ' 关闭 Word 应用程序
    WordApp.Quit
    ' 释放 Word 应用程序对象
    Set WordApp = Nothing

    ' 恢复状态栏
    Application.StatusBar = False
    ' 关闭错误处理
    On Error GoTo 0
    Exit Sub

ErrorHandler:
    ' 错误处理：显示错误信息
    MsgBox "在过程 Test 中发生错误：" & Err.Description, vbCritical, "错误"
    ' 确保 Word 应用程序关闭
    If Not WordApp Is Nothing Then
        WordApp.Quit False
        Set WordApp = Nothing
    End If
    ' 恢复状态栏
    Application.StatusBar = False
End Sub

' 检查文件是否存在的函数
Function FileExists(filePath As String) As Boolean
    FileExists = Dir(filePath) <> ""
End Function



模版文件会出现||||||n||||||| 无标注的情况下，按照有的填充

shiruiqiang

word文件都没，怎么调试？

想吃想喝想睡觉

各位大神已将附件放入

想吃想喝想睡觉

shiruiqiang 发表于 2025-3-21 17:57
word文件都没，怎么调试？

上传了哈    11111111111

gwjkkkkk

按照模板查查找替换，生成新文档？

想吃想喝想睡觉

gwjkkkkk 发表于 2025-3-23 17:48
按照模板查查找替换，生成新文档？

是的。