計(jì)量標(biāo)準(zhǔn)自查表批量生成VBA思路
在Excel表中列出計(jì)量標(biāo)準(zhǔn)名稱、計(jì)量標(biāo)準(zhǔn)考核證書編號,打開word自查表,在表格中填入對應(yīng)信息,保存到自查表文件夾中!使用For循環(huán),批量生成!
Sub 導(dǎo)出到Word模板中()
Dim Sht_Workbook As Workbook
Dim Sht_Worksheet As Worksheet
Dim Str_standardName As String
Dim Str_DepartmentName As String
Dim Str_standardNumber As String
Dim WordApp As Object
Dim WordDocNew As Object
Dim filePath As String
Dim savePath As String
Dim i As Long
' 設(shè)置當(dāng)前工作簿和工作表
Set Sht_Workbook = ThisWorkbook
Set Sht_Worksheet = Sht_Workbook.Sheets(1)
' 創(chuàng)建Word應(yīng)用程序?qū)嵗?br />
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WordApp.Visible = True ' 可選:使Word可見
' Word模板文件路徑
filePath = ThisWorkbook.Path & "\" & "自查表模板.docx"
' 遍歷Excel中的行
For i = 2 To 150 ' 根據(jù)需要調(diào)整這個(gè)范圍
' 讀取單元格的值
Str_standardName = Sht_Worksheet.Cells(i, 3).Value
Str_standardNumber = Sht_Worksheet.Cells(i, 4).Value
Str_DepartmentName = Sht_Worksheet.Cells(i, 12).Value
' 基于模板創(chuàng)建一個(gè)新文檔
savePath = ThisWorkbook.Path & "\自查表\自查表-" & Str_DepartmentName & "-" & Str_standardName & ".docx"
Set WordDocNew = WordApp.Documents.Add(Template:=filePath) ' 使用模板添加新文檔
' 在新文檔的表格中填充數(shù)據(jù)
With WordDocNew.Tables(1)
.Cell(1, 4).Range.Text = Str_standardName ' 假設(shè)表格第一行是標(biāo)題,我們從第二行開始填充數(shù)據(jù)(如果需要)
' .Cell(2, 2).Range.Text = Str_DepartmentName
.Cell(2, 4).Range.Text = Str_standardNumber
' 注意:這里可能需要根據(jù)你的實(shí)際表格結(jié)構(gòu)調(diào)整行和列索引
' ... 其他必要的填充操作
End With
' 保存新文檔
WordDocNew.SaveAs (savePath)
savePath = ThisWorkbook.Path & "\自查表\自查表-" & Str_DepartmentName & "-" & Str_standardName & ".pdf"
WordDocNew.SaveAs savePath, FileFormat:=wdFormatPDF
' 關(guān)閉新文檔(可選)
WordDocNew.Close SaveChanges:=False ' 因?yàn)槲覀円呀?jīng)用SaveAs2保存了,所以這里不需要再次保存
' 清理(可選,但在這個(gè)循環(huán)中很重要以避免內(nèi)存泄漏)
Set WordDocNew = Nothing
Next i
' 清理(可選,但在宏結(jié)束時(shí)是個(gè)好習(xí)慣)
Set WordApp = Nothing
End Sub
|
|