|
Private Sub CommandButton3_Click() '导出功能二
'将选择的工作表导出生成单独工作薄
Dim i As Long, strName, s, Mapp, Directory
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
If s < 1 Then
Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择存放目录:", &H1)
If Not Mapp Is Nothing Then
Directory = Mapp.self.Path
If Not Directory Like "*\" Then Directory = Directory & "\"
Else
MsgBox "无工作表导出!"
Exit Sub
End If
End If
strName = .List(i)
Worksheets(.List(i)).Copy
ActiveWorkbook.SaveAs Filename:=Directory & .List(i), FileFormat:=ThisWorkbook.FileFormat
MsgBox strName & " 已导出"
ActiveWorkbook.Close
s = 1
End If
Next
If s < 1 Then MsgBox " 你没有选择要导出的工作表!": GoTo 10
MsgBox "导出完成"
End With
10 Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub |
|