|
|
楼主 |
发表于 2018-10-9 23:04
|
显示全部楼层
承前，Worksheets(Array("对私库", "对公库", "合同库")).Copy或Worksheets("对私库").Copy方法下载的数据都可能是错误的！下载得到的工作表的所有单元格的字符数都在255个以内，超过的内容都丢失了，就象18位身份证号输入常规格式的单元格中，最后三位数都是0，保存后没法复原！该不幸问题也出现在另一个场合，我的《窗体按钮控件练习》试卷界面贴子中的获取题库，处理方法是采用移动或全选某表复制粘贴或区域取数赋值。
于是，对代码再作修改，复制的方法不省略，可以获得单元格格式，如下具体过程是取消工作簿保护，被复制的表全部可见，复制生成新工作簿（内存中），保存前重新取数赋值（因为移动或全选某表复制粘贴需多次激活或关闭工作簿及对新建工作簿赋予变量或命名，所以未采用），再按弹窗提示决定下载数据生成的工作簿的三种保存位置与文件名，关闭保存（磁盘中），被复制的表恢复隐藏，工作簿恢复保护，自始至终在代码所在工作簿中进行各项操作，新工作簿不可见。
Private Sub CommandButton3_Click()
ThisWorkbook.Unprotect
Application.ScreenUpdating = False
Worksheets("对私库").Visible = xlSheetVisible
Worksheets("对公库").Visible = xlSheetVisible
Worksheets("合同库").Visible = xlSheetVisible
Worksheets(Array("对私库", "对公库", "合同库")).Copy
With ThisWorkbook.Worksheets("对私库").Cells(1).CurrentRegion
ActiveWorkbook.Worksheets("对私库").Cells(1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
With ThisWorkbook.Worksheets("对公库").Cells(1).CurrentRegion
ActiveWorkbook.Worksheets("对公库").Cells(1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
With ThisWorkbook.Worksheets("合同库").Cells(1).CurrentRegion
ActiveWorkbook.Worksheets("合同库").Cells(1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
Dim mstr As String
mstr = InputBox("1、如在文本框中输录数字 1 后单击确定或回车，可把数据导出至当前位置；" & Chr(10) & "2、如在文本框中输录数字 2 后单击确定或回车，可把数据导出至桌面；" & Chr(10) & "3、否则您需自定义保存位置与文件名。")
On Error GoTo r
With ActiveWorkbook
If mstr = 1 Then
.SaveAs Filename:=ThisWorkbook.Path & "\" & Format(Now(), "客户借款数据库yyyymmdd hhmmss") & ".xls"
ElseIf mstr = 2 Then
.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now(), "客户借款数据库yyyymmdd hhmmss") & ".xls"
End If
Application.CommandBars("Control Toolbox").Visible = True
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=0, Top:=250, Width:=123, Height:=36.75).Select
Application.CommandBars("Control Toolbox").Visible = False
.Close savechanges:=True
End With
Worksheets(Array("对私库", "对公库", "合同库")).Visible = xlSheetHidden
Application.ScreenUpdating = True
ThisWorkbook.Protect
ThisWorkbook.Close savechanges:=False
MsgBox "拷贝完毕。"
Exit Sub
r: 'MsgBox "稍后执行:Application.Dialogs(5).Show!"
Windows("借款簿(有宏有按钮)20170712.xls").Activate
Worksheets(Array("对私库", "对公库", "合同库")).Visible = xlSheetHidden
Application.ScreenUpdating = True
ThisWorkbook.Protect
MsgBox "拷贝完毕。"
End Sub
|
|
楼主: OKJSJSF
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-10-10 08:26