計(jì)量論壇

 找回密碼
 立即注冊

QQ登錄

只需一步,快速開始

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

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

[復(fù)制鏈接]
跳轉(zhuǎn)到指定樓層
1#
iceriver 發(fā)表于 2025-4-29 14:11:23 | 只看該作者 回帖獎勵 |倒序?yàn)g覽 |閱讀模式
計(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

計(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號-1—304所 )
電話:0592-5613810 QQ:473647 微信:gfjlbbs閩公網(wǎng)安備 35020602000072號

GMT+8, 2025-7-18 11:54

Powered by Discuz! X3.4

Copyright © 2001-2023, Tencent Cloud.

快速回復(fù) 返回頂部 返回列表
主站蜘蛛池模板: 上课公然调教h| 免费高清日本1在线观看| 久久精品私人影院免费看| avav在线看| 最近中文字幕免费mv视频7| 国产精品免费视频播放器| 亚洲人成色77777| 麻豆国产精品有码在线观看| 最近2019免费中文字幕视频三| 国产精品久久久久久亚洲小说 | 可知子与野鸟君日文| 中文字幕亚洲日韩无线码| 美团外卖猛男男同38分钟| 思思久久99热只有频精品66| 免费看美女脱衣服| MM1313亚洲精品无码| 毛片在线看免费| 国产精品免费αv视频| 亚洲av日韩综合一区久热| 黄色片在线播放| 日日碰狠狠添天天爽不卡| 四虎在线视频免费观看| а√最新版地址在线天堂| 浮力影院第一页小视频国产在线观看免费 | 九一在线完整视频免费观看| 黄网站在线播放| 日出水了特别黄的视频| 午夜爽爽爽视频| 99久久99久久精品国产片果冻| 欧美美女视频网站| 国产无遮挡无码视频免费软件| 久久午夜福利无码1000合集| 老师你下面好湿好深视频| 天天摸天天做天天爽天天弄| 亚洲日韩中文字幕在线播放| 成人国产在线24小时播放视频| 日本大乳高潮视频在线观看| 免费黄色软件在线观看| 91av电影在线观看| 日韩欧美三级在线观看| 台湾一级淫片高清视频|