留个基础版,方便以后捡。
先是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