作者：绿色风
分类：
时间：2022-08-18
浏览：74
楼主
amulee |
利用VBA中的对话框其实可以实现很多功能。
以下代码为创建文件的向导。注意循环语句和InputBox结合的用法，可以避免用户输入错误的数据。
- Sub 开始()
- Dim ShtCount
- Dim Wbk As Workbook
- Dim ShtTemp
- Dim Pass
- Dim FName
- Dim RngBT As Range
- On Error Resume Next
- If MsgBox("本程序用来创建工作簿。是否继续？", vbYesNo) = vbYes Then
- '获取工作表数量
- ShtCount = Application.InputBox("请输入改工作簿中表格数量", Type:=1)
- Do While ShtCount < 1 Or ShtCount > 10 '点击取消之后False是小于1的，这样判断条件就可以合并了
- If VarType(ShtCount) = vbBoolean Then '这个判断用于判断是否取消，在动画里面没有要求。
- MsgBox "您未输入数量"
- Else
- If ShtCount < 1 Then '如果小于1
- MsgBox "您的输入小于1。您应该至少创建一个工作表。"
- Else '其他的当然就是大于10的情况
- MsgBox "您的输入大于10。本程序最多只能创建10个工作表。"
- End If
- End If
- ShtCount = Application.InputBox("请再次输入改工作簿中表格数量", Type:=1)
- Loop
- '获取表头
- If MsgBox("是否创建表头？", vbYesNo) = vbYes Then
- Set RngBT = Application.InputBox("请选择表头区域", Type:=8)
- Do While Err.Number <> 0
- Err.Clear '清除错误
- Set RngBT = Application.InputBox("您未选择 ！请重新选择表头区域", Type:=8)
- Loop
- End If
- '创建密码
- If MsgBox("是否创建密码？", vbYesNo) = vbYes Then
- Pass = Application.InputBox("请输入密码", Type:=2)
- Do While Pass = False Or Pass = ""
- Pass = Application.InputBox("密码不能为空！请重新输入！", Type:=2)
- Loop
- End If
- '选择保存路径
- FName = Application.GetSaveAsFilename("新文件", "Excel,*.xls", , "输出文件")
- Do While FName = False
- FName = Application.GetSaveAsFilename("新文件", "Excel,*.xls", , "输出文件")
- Loop
- '接下来进行创建工作表和保存工作表的操作
-
- Application.ScreenUpdating = False
- '先记录原创建工作簿工作表的数量
- ShtTemp = Application.SheetsInNewWorkbook
-
- '设定新的数量
- Application.SheetsInNewWorkbook = ShtCount
-
- '新建工作簿
- Set Wbk = Workbooks.Add
-
- '恢复原数量
- Application.SheetsInNewWorkbook = ShtTemp
-
- '如果有表头则创建表头
- If Not RngBT Is Nothing Then
- RngBT.Copy Wbk.Worksheets(1).Range("A1")
- Wbk.Worksheets.FillAcrossSheets Wbk.Worksheets(1).UsedRange, xlFillWithAll
- End If
-
- '如果有密码就创建密码
- If Pass <> "" Then
- Wbk.Password = Pass
- End If
-
- '保存工作簿
- Wbk.Close True, FName
- Application.ScreenUpdating = True
- End If
- End Sub
 创建向导.rar
|
2楼
亡者天下 |
这个有什么应用啊？
|
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一