Alex_Piggy
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Код:
Sub SaveSheets()
Dim oSelSheet As Worksheet: Dim vFolder As String
vFolder = GetFolder & "\"
For Each oSelSheet In ActiveWindow.SelectedSheets
oSelSheet.Copy
With ActiveWorkbook
.SaveAs Filename:=vFolder & ReplaceName(oSelSheet.Name) & ".xlsx", FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
Next
End Sub
Function GetFolder() As String
Dim fldr As FileDialog: Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder": .AllowMultiSelect = False: .InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Function ReplaceName(vOldName As String) As String
Dim vTmpStr As String, vBadChar As Variant: vTmpStr = vOldName
For Each vBadChar In Array(":", "\", "/", """", "?", "<", ">", "^", "*")
vTmpStr = Replace(vTmpStr, vBadChar, "_")
Next vBadChar
ReplaceName = vTmpStr
End Function |
|
