用VSTO生成模板合同

a-zzl

VSTO程序实现功能：用户选择的窗口，有以下几个功能区块： 一、合并多word：提供每一个word名对应的复选框，勾选后可以实现按顺序一键合并选中的那几个word； 二、插入目录，固定在第二页插入一个4级目录； 三，一键设置正文字体，一键设置一级标题字体，一键设置二级目录字体，一键设置三级目录字体（字体任选，我后期改代码中的字体）

财源滚滚来（）

Sub GenerateContracts()     Dim ws As Worksheet     Dim contractDoc As Object     Dim contractPath As String     Dim lastRow As Long     Dim i As Long          ' 设置工作表     Set ws = ThisWorkbook.Sheets("合同模板")          ' 获取最后一行     lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row          ' 设置合同文档保存路径     contractPath = ThisWorkbook.Path & "\合同_"          ' 循环生成合同     For i = 2 To lastRow         ' 创建Word应用程序         Set contractDoc = CreateObject("Word.Application")         contractDoc.Visible = False                  ' 创建新文档         contractDoc.Documents.Add                  ' 添加合同内容         With contractDoc             .Content.Text = "合同编号: " & ws.Cells(i, 1).Value & vbCrLf & _                             "公司名称: " & ws.Cells(i, 2).Value & vbCrLf & _                             "地址: " & ws.Cells(i, 3).Value & vbCrLf & _                             "联系人: " & ws.Cells(i, 4).Value & vbCrLf & _                             "合同条款: " & ws.Cells(i, 5).Value & vbCrLf & _                             "签署日期: " & ws.Cells(i, 6).Value         End With                  ' 保存合同文档         contractDoc.ActiveDocument.SaveAs2 contractPath & ws.Cells(i, 1).Value & ".docx"         contractDoc.ActiveDocument.Close         contractDoc.Quit     Next i          MsgBox "合同生成完成！" End Sub

财源滚滚来（）

Sub GenerateContracts()
    Dim ws As Worksheet
    Dim contractDoc As Object
    Dim contractPath As String
    Dim lastRow As Long
    Dim i As Long
   
    ' 设置工作表
    Set ws = ThisWorkbook.Sheets("合同模板")
   
    ' 获取最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
   
    ' 设置合同文档保存路径
    contractPath = ThisWorkbook.Path & "\合同_"
   
    ' 循环生成合同
    For i = 2 To lastRow
        ' 创建Word应用程序
        Set contractDoc = CreateObject("Word.Application")
        contractDoc.Visible = False
        
        ' 创建新文档
        contractDoc.Documents.Add
        
        ' 添加合同内容
        With contractDoc
            .Content.Text = "合同编号: " & ws.Cells(i, 1).Value & vbCrLf & _
                            "公司名称: " & ws.Cells(i, 2).Value & vbCrLf & _
                            "地址: " & ws.Cells(i, 3).Value & vbCrLf & _
                            "联系人: " & ws.Cells(i, 4).Value & vbCrLf & _
                            "合同条款: " & ws.Cells(i, 5).Value & vbCrLf & _
                            "签署日期: " & ws.Cells(i, 6).Value
        End With
        
        ' 保存合同文档
        contractDoc.ActiveDocument.SaveAs2 contractPath & ws.Cells(i, 1).Value & ".docx"
        contractDoc.ActiveDocument.Close
        contractDoc.Quit
    Next i
   
    MsgBox "合同生成完成！"
End Sub