VBA实现自动生成EXCEL表代码

合集下载
相关主题
  1. 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim work_dir As String
Dim muban_dir As String
Dim pinguzongbiao_dir As String
Dim shengchengbiao_dir As String

Dim muban_name As String
Dim pinguzongbiao_name As String
Dim shengchengbiao_name As String

Dim muban_path As String
Dim pinguzongbiao_path As String
Dim shengchengbiao_path As String

Dim i, bigin_row, stop_row As String
Dim file_name As String
Dim kehumingchen As String
Dim liucheng_id As String
Dim kehudizhi As String
Dim kehujingli As String
Dim lianxiren As String
Dim yueshouru As String
Dim weihufei As String
Dim guandaojianshe As String
Dim guandaotouzi As String
Dim guanglanjianshe As String
Dim guanglantouzi As String
Dim shebeijianshe As String
Dim shebeitouzi As String
Dim shejifei As String
Dim jianlifei As String
Dim zongtouzi As String


bigin_row = TextBox1.Value
stop_row = TextBox2.Value

If (bigin_row = "" Or stop_row = "") Then
MsgBox ("行号不能为空值!请重新输入!")
Exit Sub
End If

If bigin_row > stop_row Then
MsgBox ("结束行号不能小于开始行号!请重新输入!")
Exit Sub
End If




'获取当前工作路径
work_dir = ActiveWorkbook.Path
muban_dir = work_dir & "\模板"
pinguzongbiao_dir = work_dir & "\评估总表"
shengchengbiao_dir = work_dir & "\生成表"

muban_name = Dir(muban_dir & "\*.xls*")
If (muban_name = "") Then
MsgBox ("模板文件不存在!")
Exit Sub
End If

pinguzongbiao_name = Dir(pinguzongbiao_dir & "\*.xls*")
If (pinguzongbiao_name = "") Then
MsgBox ("评估总表文件不存在!")
Exit Sub
End If

muban_path = muban_dir & "\" & muban_name
pinguzongbiao_path = pinguzongbiao_dir & "\" & pinguzongbiao_name

For i = 1 To Windows.Count
If Windows(i).Caption = pinguzongbiao_name Then
MsgBox "评估总表文件已经打开,请关闭后再运行程序!"
Exit Sub
End If
Next i

For i = 1 To Windows.Count
If Windows(i).Caption = muban_name Then
MsgBox "模板文件已经打开,请关闭后再运行程序!"
Exit Sub
End If
Next i

Workbooks.Open pinguzongbiao_path

For i = bigin_row To stop_row
Workbooks.Open muban_path
liucheng_id = Workbooks(pinguzongbiao_name).Sheets(1).Range("B" & i)
kehumingchen = Workbooks(pinguzongbiao_name).Sheets(1).Range("C" & i)
kehudizhi = Workbooks(pinguzongbiao_name).Sheets(1).Range("D" & i)
kehujingli = Workbooks(pinguzongbiao_name).Sheets(1).Range("E" & i)
lianxiren = Workbooks(pinguzongbiao_name).Sheets(1).Range("F"

& i)
yueshouru = Workbooks(pinguzongbiao_name).Sheets(1).Range("G" & i)
weihufei = Workbooks(pinguzongbiao_name).Sheets(1).Range("H" & i)
guandaojianshe = Workbooks(pinguzongbiao_name).Sheets(1).Range("I" & i)
guandaotouzi = Workbooks(pinguzongbiao_name).Sheets(1).Range("J" & i)
guanglanjianshe = Workbooks(pinguzongbiao_name).Sheets(1).Range("K" & i)
guanglantouzi = Workbooks(pinguzongbiao_name).Sheets(1).Range("L" & i)
shebeijianshe = Workbooks(pinguzongbiao_name).Sheets(1).Range("M" & i)
shebeitouzi = Workbooks(pinguzongbiao_name).Sheets(1).Range("N" & i)
shejifei = Workbooks(pinguzongbiao_name).Sheets(1).Range("O" & i)
jianlifei = Workbooks(pinguzongbiao_name).Sheets(1).Range("P" & i)
zongtouzi = Workbooks(pinguzongbiao_name).Sheets(1).Range("Q" & i)


file_name = liucheng_id & "-【" & kehumingchen & "】投资评估表.xlsx"
Workbooks(muban_name).SaveAs Filename:=shengchengbiao_dir & "\" & file_name

Workbooks(file_name).Sheets("项目收益评估书").Range("E3").Value = kehumingchen
Workbooks(file_name).Sheets("项目收益评估书").Range("E4").Value = kehudizhi
Workbooks(file_name).Sheets("项目收益评估书").Range("E6").Value = kehujingli
Workbooks(file_name).Sheets("项目收益评估书").Range("J6").Value = lianxiren
Workbooks(file_name).Sheets("项目收益评估书").Range("E9").Value = yueshouru
Workbooks(file_name).Sheets("项目收益评估书").Range("E13").Value = weihufei
Workbooks(file_name).Sheets("项目收益评估书").Range("E14").Value = guandaojianshe
Workbooks(file_name).Sheets("项目收益评估书").Range("H14").Value = guandaotouzi
Workbooks(file_name).Sheets("项目收益评估书").Range("E15").Value = guanglanjianshe
Workbooks(file_name).Sheets("项目收益评估书").Range("H15").Value = guanglantouzi
Workbooks(file_name).Sheets("项目收益评估书").Range("E16").Value = shebeijianshe
Workbooks(file_name).Sheets("项目收益评估书").Range("H16").Value = shebeitouzi
Workbooks(file_name).Sheets("项目收益评估书").Range("H18").Value = shejifei
Workbooks(file_name).Sheets("项目收益评估书").Range("H19").Value = jianlifei
Workbooks(file_name).Sheets("项目收益评估书").Range("J21").Value = zongtouzi


Workbooks(file_name).Save
Workbooks(file_name).Close
Next i

Workbooks(pinguzongbiao_name).Close

MsgBox "执行完毕,共生成" & stop_row - bigin_row + 1 & "个文件,文件位于“生成表”目录下!"

End Sub


相关文档
最新文档