Excel文件弹出另存为代码
'保存数据按钮事件
Private Sub SaveData_Click()
Dim fso, oFile, sXml, fname, objStream
Dim i
'定义导出的文件名
fname = "Rebate_Report1_" & Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & " " & Hour(Now()) & "^" & Minute(Now()) & "^" & Second(Now())
'显示另存为文件框以及保存为何种文件
fname = Application.GetSaveAsFilename(InitialFileName:=fname, fileFilter:="HEX file (*.hex), *.hex")
'如果成功打开对话框
If fname <> False Then
'ActiveWorkbook.Save
'以文件流形式保存
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Open
.Charset = "utf-16"
.Position = objStream.Size
'获取Excel中的数据转为xml文件
.WriteText = getSheetXml
.SaveToFile fname, 2
.Close
End With
Set objStream = Nothing
MsgBox "The report file has been saved successfully."
End If
End Sub
Private Sub SaveData_Click()
Dim fso, oFile, sXml, fname, objStream
Dim i
'定义导出的文件名
fname = "Rebate_Report1_" & Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & " " & Hour(Now()) & "^" & Minute(Now()) & "^" & Second(Now())
'显示另存为文件框以及保存为何种文件
fname = Application.GetSaveAsFilename(InitialFileName:=fname, fileFilter:="HEX file (*.hex), *.hex")
'如果成功打开对话框
If fname <> False Then
'ActiveWorkbook.Save
'以文件流形式保存
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Open
.Charset = "utf-16"
.Position = objStream.Size
'获取Excel中的数据转为xml文件
.WriteText = getSheetXml
.SaveToFile fname, 2
.Close
End With
Set objStream = Nothing
MsgBox "The report file has been saved successfully."
End If
End Sub