使用VB将excel用例自动转填到word规程用例

一、背景描述

最近工作遇到需要繁琐的复制粘贴工作，即需要将excel格式的测试用例某些内容复制，再填写到word格式的版本中作为规程存档，这需要将excel用例中的对应内容复制粘贴到word模版的指定位置，用例太多这种复制粘贴较耗时。因此自己借助deepseek编写VB代码，实现自动将excel指定内容复制到word模版的指定位置，以此减少这一枯燥的工作量。接下来对我实现过程进行总结分享。

下面以几个简单登录的测试用例为例，如下图为excel表格中三个字段分别为‘TC步骤’、‘TC操作’、‘TC预期结果’，其中‘TC步骤’表示测试用例有几步，可见第一个用例有3步，每从1开始就是一个新用例，如下图可见有四个关于登录验证的用例，我打算将每个用例的测试操作和结果填写到对应的word表格中，有几个用例就循环填写到几个word表格中。

将要填写的word表格格式如下：其中‘标题’、‘测试目的’、‘预置条件’、‘测试步骤’、‘预期结果’中的内容都是从excel中自动获取的，实现了将excel中若干个用例逐个填写到多个word表格中。具体想在excel中获取哪些字段填写到word的哪个位置，根据下面代码灵活调整即可。

最后，在代码执行过程中，在excel下方会显示进度条用于查看执行进度.....

二、AI交互

编码过程中请求AI协助，和deepseek进行数轮交互，其中也遇到了很多问题，但最后都在其帮助下解决了，截取部分prompt提示词如下。

1、VBA在操作word文档时.Collapse Direction:=1的用法举例

2、使用Selection.InsertRowsBelow 1编程方法后，提示对象不支持该属性或方法

3、添加语句"Dim tbl As Table"后执行系统报错“用户定义类型未定义”是什么原因

4、我在代码中使用的是"Dim wordApp As Object, wordDoc As Object"来声明的对象，所以以这种对象声明的方式应该没有类似Table.Row()，Selection.InsertRowsBelow等类似直接对表格行处理的操作对么

5、Set tb1 = wordDoc.Tables(1) tb1.Rows.Add (tb1.Rows(3))这个是在表格中插入一行的方法，有没有类似指定某一行进行删除的方法？

6、上面代码中‘.Collapse Direction:=0 ' 0=wdCollapseEnd（定位到段落末尾）‌:ml-citation{ref="2,3" data="citationList"} ’这条代码什么意思

7、例如我有word文档，有编号：1.1.1.1.、1.1.1.2.、1.1.1.3.等等。。。如何将excel数据直接插入到这些编号后面

8、我使用如下代码并运行 “If para.Range.ListFormat.ListValueString Like "1.1.1.*" Then ”这行代码报错不支持这种属性或者方法？

9、我的word中有一个三级标题，三级标题下有四级标题，四级标题下有个表格。我想选中四级标题和其下面的表格将其复制到下面，并执行粘贴多次，假设我之前有一个四级标题和一个表格，那么经过我粘贴三次后，当前就有了四个四级标题和四个表格，如何通过VBA编程来实现

10、运行上输出代码提示‘headingRange.End = tableRange.Range.End’代码中的Range参数不可选？

11、这行代码如何理解“progressBar = WorksheetFunction.Rept("■", i \ 5) & WorksheetFunction.Rept("□", 20 - (i \ 5)) '每5%显示一个块‌:ml-citation{ref="2" data="citationList"}”

12、progressBar = WorksheetFunction.Rept("■", i \ 5) & WorksheetFunction.Rept("□", 20 - (i \ 5)) '每5%显示一个块‌:ml-citation{ref="2" data="citationList"}将这个代码放到程序中，本想让他实时显示程序执行进度，但是在程序执行中excel是进度条是不动的，直到程序执行完成才显示最终100%完成的进度条结果

三、代码实现

打开需要获取内容的excel文档，选择【开发工具】---【VB编辑器】进入VB编辑器后，点击新建【模块】后，将代码粘贴到模块上执行。

注：1、由于WPS使用了宏，所以的excel需要另存为xlsm格式。

2、有几个excel用例需要转填，就需要几个word模版表格，所以运行前需要准备好word模版，直接按照上面word模版复制和excel用例个数相同的word表格即可，word表格中原有内容不需要删除会自动覆盖。

Sub excel2word()
    Dim ws As Worksheet
    Dim DataRange As Range
    Dim wordApp As Object, wordDoc As Object, tbl As Object
      
    Dim str, str2, str3, headername1, headername2, headername3, headername4, headername5 As String
    Dim num, rowCount, colCount, i, g, p As Integer
    Dim found As Boolean
    Dim title, precondition, TCstep, TCop, TCpredict, progress As Long
    Dim searchtext As String
    
    Dim para As Object
    
    'Dim wordApp As Application
    'Dim wordDoc As Document
    'Dim tbl As Table
    Dim progressBar As String
    
    
    '【初始化excel文档、word文档，获取excel行数、列数以及需要的字段内容】
    Set ws = ThisWorkbook.Sheets("template")
    headername1 = "标题"
    headername2 = "预置条件"
    headername3 = "TC步骤"
    headername4 = "TC操作"
    headername5 = "TC预期结果"
    found = False
    
    colCount = ws.UsedRange.Columns.Count '获取excel有数据的列数
    rowCount = ws.UsedRange.Rows.Count '获取excel有数据的行数
    
    Set DataRange = ws.Range(ws.Cells(1, 1), ws.Cells(rowCount, colCount))
    i = 0
    g = 0
    p = 0
   
  '优化前54.47秒  优化后49.76秒 （不加最后的and判断）
  title = 0
  precondition = 0
  TCstep = 0
  TCop = 0
  TCpredict = 0
  
    For Each cell In DataRange.Rows(1).Cells
        If cell.Value = headername1 Then
            title = cell.Column
        ElseIf cell.Value = headername2 Then
            precondition = cell.Column
        
        ElseIf cell.Value = headername3 Then
            TCstep = cell.Column
        
        ElseIf cell.Value = headername4 Then
            TCop = cell.Column
        
        ElseIf cell.Value = headername5 Then
            TCpredict = cell.Column
            
        'ElseIf title > 0 And precondition > 0 And TCstep > 0 And TCop > 0 And TCpredict > 0 Then
        '    Exit For ' 全部找到后退出循环
        End If
    Next cell
        
    
    Set wordApp = CreateObject("Word.Application") ' 创建Word对象并打开文档
    'Set wordApp = New Word.Application
   
    wordApp.Visible = True  ' 显示Word程序以便调试
    Set wordDoc = wordApp.Documents.Open("D:\wng项目\VBAexcel2word\ceshi.docx", ReadOnly:=False) 'readonly可以不写只要后面释放正确，就不担心word再次打开为只读

     
    
    '【每个word表格行数调整，确保每个表格行数正好适配每个用例】
    searchtext = "其它说明"
     '判断行数够不够，多则删除少则增加，先将除第一行以后的多余行删除，再根据需要在所有word表格中进行前向插入。
    For h = 2 To rowCount
        str = DataRange.Cells(h, TCstep).Value '获取TC步骤的数值
        num = CInt(str) '将字符转为数字
        
        If num = 1 Then
            g = g + 1
        End If
        
        
        If num > 1 Then
            Set tb1 = wordDoc.Tables(g) '无效的调用过程或参数，原因是word当中缺少表格，把表格加全就好了
            
            While InStr(wordDoc.Tables(g).cell(num + 5, 1).Range.Text, searchtext) = 0 '将word表格中num+5后多余的行删除
                tb1.Rows(num + 5).Delete
            Wend
            
            If InStr(wordDoc.Tables(g).cell(num + 5, 1).Range.Text, searchtext) Then
                      
                tb1.Rows.Add (tb1.Rows(num + 4)) '在num+4前插入行，deepseek说是在num+4后插入行，deepseek说错了，应该是在前插入行

            End If
        End If
    Next h
        

    
    
   '【循环向word中插入excel数据】

    For k = 2 To rowCount
        str = DataRange.Cells(k, TCstep).Value '获取TC步骤的数值
        num = CInt(str) '将字符转为数字
        

        If num = 1 Then
            i = i + 1
            str2 = CStr(i)
            str3 = "1.1.1." + str2 + "."
            
             '将excel标题插入到word类似1.1.1.1标题后
            For Each para In wordDoc.Paragraphs
            
             ' 判断段落是否包含目标编号（如 1.1.1.1）
                If para.Range.ListFormat.ListString Like str3 Then
                     ' 在编号后插入数据
                     With para.Range
                        .Collapse Direction:=1  ' 参数设置为0插入了段落的后面，但是结果是插入到了表格里面了。参数为1插入了段落的最前面。
                        .InsertAfter ws.Columns(title).Cells(k)  ' 插入 Excel 数据?:ml-citation{ref="4" data="citationList"}
                     End With
                     
                     Exit For '插入后退出循环
                 End If
            Next para
            
            wordDoc.Tables(i).cell(1, 2) = ws.Columns(title).Cells(k)
            wordDoc.Tables(i).cell(4, 2) = ws.Columns(precondition).Cells(k)
        End If
        
           
        wordDoc.Tables(i).cell(num + 5, 1).Range.Text = DataRange.Cells(k, TCop).Value
        wordDoc.Tables(i).cell(num + 5, 2).Range.Text = DataRange.Cells(k, TCpredict).Value
        
        
        
        
        '【进度条显示】
          
        'MsgBox "处理中。。。%" '需要每次进行点击确定的用户交互操作，不适用
        p = k
        progressBar = WorksheetFunction.Rept("■", p \ 1) & WorksheetFunction.Rept("□", rowCount - (p \ 1)) '每5%显示一个块?:ml-citation{ref="2" data="citationList"}
        Application.StatusBar = "处理进度: " & progressBar & " " & Format(p / rowCount, "0%")  '实时更新?:ml-citation{ref="1" data="citationList"}
        DoEvents      '解决excel不更新问题
          
    Next k
    
   
   

    ' 释放对象
    wordDoc.Save
    wordDoc.Close
    wordApp.Quit
    Set DataRange = Nothing
    Set ws = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
    Application.Wait Now + TimeValue("0:00:01")
    Application.StatusBar = False
End Sub

四、编程过程中AI交互总结

需求很明确，看着实现逻辑也比较清晰、简单，但实际编程过程又是一次缝缝补补，因为虽然了解VB是用于处理office软件的开发工具。但是真正使用VB语言操作office办公软件还是第一次。

经过和AI多次洽谈主要总结如下：

1、每次询问让大模型给出实例，根据实例运行结果将错误出现的位置代码复制，结合报错的原因一起再对AI追问

2、执行报错可能是因为你对某行代码不理解而错误使用对象导致，可复制不理解的代码让AI给出详细解释并举例说明，或直接询问我这样使用了但是报错这种使用方式是否正确

3、不同时刻AI的回答可能是相反的，比如这次回答：Direction:=0 ' 0=wdCollapseEnd，Direction:=1 ' 0=wdCollapsestart

下次回答Direction:=0 ' 0=wdCollapseStart，Direction:=1 ' 0=wdCollapseEnd，又或者回答错误，例如：某行代码AI说实现是在后插入行，运行结果是在前插入了行。可以下次提问中纠正其错误

4、有时发现自己提问中对某个场景的语言描述不够精准，但AI的回答中却使用了你想用却想不起来的词汇，那么你下次再提问就可以用这个词汇了。所以应该没啥提问技巧吧，所谓的提问技巧就是在不断提问中得到的。