計(jì)量論壇

 找回密碼
 立即注冊(cè)

QQ登錄

只需一步,快速開始

搜索
打印 上一主題 下一主題

[質(zhì)量控制] 計(jì)量標(biāo)準(zhǔn)自查表批量生成

[復(fù)制鏈接]
跳轉(zhuǎn)到指定樓層
1#
iceriver 發(fā)表于 2025-4-29 14:11:23 | 只看該作者 回帖獎(jiǎng)勵(lì) |倒序?yàn)g覽 |閱讀模式
計(jì)量標(biāo)準(zhǔn)自查表批量生成VBA思路
在Excel表中列出計(jì)量標(biāo)準(zhǔn)名稱、計(jì)量標(biāo)準(zhǔn)考核證書編號(hào),打開word自查表,在表格中填入對(duì)應(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

計(jì)量標(biāo)準(zhǔn)自查表生成 VBA.zip

346.79 KB, 下載次數(shù): 14, 下載積分: 金幣 -1

2#
wxbnemo 發(fā)表于 2025-4-29 14:24:31 | 只看該作者
謝謝,學(xué)習(xí)了

本版積分規(guī)則

小黑屋|Archiver|計(jì)量論壇 ( 閩ICP備06005787號(hào)-1—304所 )
電話:0592-5613810 QQ:473647 微信:gfjlbbs閩公網(wǎng)安備 35020602000072號(hào)

GMT+8, 2025-7-18 08:57

Powered by Discuz! X3.4

Copyright © 2001-2023, Tencent Cloud.

快速回復(fù) 返回頂部 返回列表
主站蜘蛛池模板: **性色生活片毛片| 亚洲AV无码一区二区一二区| 中文字幕你懂的| 日韩欧美成人乱码一在线| 国产白嫩美女在线观看| 亚洲人成电影在线观看网 | 羞羞视频免费网站入口| 性欧美视频在线观看| 亚洲黄色网址大全| 18禁裸体动漫美女无遮挡网站| 最近中文字幕mv在线视频www| 国产丝袜无码一区二区三区视频| 一级视频免费观看| 波多野结衣mdyd907| 国产欧美日韩综合精品一区二区| 久久国产中文字幕| 精品无人区麻豆乱码1区2区| 国模精品一区二区三区| 久久综合国产乱子伦精品免费| 美女黄网站人色视频免费国产| 天下第一社区视频welcome | 国产-第1页-浮力影院| flstingextreme头交| 欧美亚洲国产成人综合在线| 国产亚洲综合色就色| h视频免费观看| 榴莲视频app色版| 四虎影在线永久免费观看| 91香蕉在线看私人影院| 日本精品在线观看视频| 伊人狼人综合网| 国产人成精品香港三级在| 成人国产激情福利久久精品| 亚洲欧洲另类春色校园网站| 超碰aⅴ人人做人人爽欧美| 天天爽夜夜爽人人爽一区二区| 亚洲一区二区影院| 精品综合久久久久久8888| 国产精欧美一区二区三区| 久久99精品久久久久久hb无码 | 4虎永免费最新永久免费地址|