vba 控制excel与word

留个基础版，方便以后捡。

先是ThisWorkbook文件针对这个工作簿本身的一些默认操作。

Option Explicit

Private Sub Workbook_Open() '打开工作簿运行

'设定整个worksheet为文本格式

    Sheets("statement_info").UsedRange.NumberFormat = "@"
    
'默认保留的乘客信息
    Sheets("statement_info").Cells(3, 5).Value = "client's name"
    Sheets("statement_info").Cells(3, 6).Value = "client_id"
    
    

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) '关闭工作簿前运行
'
'

   Dim r_int As Integer  '注意这个是public
   r_int = 2 '第r行及以上要保留,否则删掉内容
   Sheets("statement_info").Rows(r_int + 1 & ":" & Sheets("statement_info").Rows.Count).ClearContents   '这样格式将保留
   

End Sub

接下来创立一个module 都在module里面写了。

Option Explicit
Sub Generator()

    Application.ScreenUpdating = False '增快程序速度

    Dim bName, lName As String
    Dim b_save, l_save As String

    Dim AWB_No As String
    Dim AWB_No_first As String
    Dim Ft_No As String
    Dim Sh_Date As String
    Dim Si_Date As String
    Dim POA_Name As String
    Dim POA_ID As String
    Dim date_Str As String
    Dim r_int As Integer 'row
   
'默认路径与文件生成的日期后缀

    lName = "C:\Users\wosh\Desktop\声明模板\fol_Statement.docx"   '给出模板文件默认位置
    bName = "C:\Users\wosh\Desktop\声明模板\bol_POA.docx"         '给出模板文件默认位置
    date_Str = WorksheetFunction.Text(Date, "yyyy""年""m""月""d""日"";@")
    
'get input values from excel

    Dim acSht
    Set acSht = Worksheets("statement_info")
    AWB_No = acSht.Cells(3, 1).Value    'AWB_No下的那个格子里的值
    F_No = acSht.Cells(3, 2).Value
    Sh_Date = acSht.Cells(3, 3).Value
    Si_Date = acSht.Cells(3, 4).Value
    POA_Name = acSht.Cells(3, 5).Value
    POA_ID = " " + acSht.Cells(3, 6).Value
    
    AWB_No_first = Split(AWB_No, ",")(0)   '单号也不怕
    


'bol save as name
    Dim bsv

    bsv = Right(bName, Len(bName) - InStrRev(bName, "\"))
    bsv = Left(bsv, InStr(bsv, ".") - 1) + "__" + AWB_No_first + "_" + date_Str
    b_save = bsv & ".docx"

'lof statement save as name
    Dim lsv
    
    lsv = Right(lName, Len(lName) - InStrRev(lName, "\"))
    lsv = Left(lsv, InStr(lsv, ".") - 1) + "__" + AWB_No_first + "_" + date_Str
    l_save = lsv & ".docx"
    
'start to execute word related vb program,因函数exeWord无返回值，所以exeWord不要后面加括号，不然报:=错误
    
    exeWord bName, b_save, AWB_No, Fl_No, Sh_Date, Si_Date, POA_Name, POA_ID
    exeWord lName, l_save, AWB_No, Fl_No, Sh_Date, Si_Date, POA_Name, POA_ID


'remove all the contents in worksheet-statement_info
    r_int = 2
    Sheets("statement_info").Rows(r_int + 1 & ":" & Sheets("statement_info").Rows.Count).ClearContents   '这样格式将保留
    
    Application.ScreenUpdating = True
    
End Sub

Sub exeWord(sFName, curDoc, AWB_No, F_No, Sh_Date, Si_Date, POA_Name, POA_ID) '传入1.模板名字和 2.另存为名字,接下来的arg都是为了modWord
'
'
    Dim lastFolder As String
    Dim lastMark As Integer
    Dim myPath As String
    Dim docApp
    Dim wDoc
    
    lastFolder = "in_bulk"                                       'in_bulk文件夹一定要存在
    lastMark = InStrRev(sFName, "\")                             ' 反向查找最后一个"\"符号位置
    
    myPath = Left(sFName, lastMark) & lastFolder & "\"
    
    Set docApp = CreateObject("Word.Application")               '为docApp变量赋值
    Set wDoc = docApp.Documents.Add(Template:=sFName, NewTemplate:=False, DocumentType:=0)

'modify word document
    modWord wDoc, AWB_No, F_No, Sh_Date, Si_Date, POA_Name, POA_ID
    
'save the word file and set app to nothing
    Dim allcurDoc
    
    allcurDoc = myPath & curDoc
    wDoc.SaveAs Filename:=allcurDoc '保存Word文档到变量filesavename
    wDoc.Close
    docApp.Quit
    Set docApp = Nothing

End Sub

Sub modWord(Fword, AWB_No, F_No, Sh_Date, Si_Date, POA_Name, POA_ID) 'vb改写word文件
 

    With Fword.Content
        .Find.Execute FindText:="Si_Date", ReplaceWith:=Si_Date, Replace:=2
        .Find.Execute FindText:="AWB_No", ReplaceWith:=AWB_No, Replace:=2
        .Find.Execute FindText:="F_No", ReplaceWith:=F_No, Replace:=2
        .Find.Execute FindText:="Sh_Date", ReplaceWith:=Sh_Date, Replace:=2
        .Find.Execute FindText:="POA_Name", ReplaceWith:=POA_Name, Replace:=2
        .Find.Execute FindText:="POA_ID", ReplaceWith:=POA_ID, Replace:=2
    End With
    

End Sub