Как сохранить рабочие листы в виде отдельных рабочих книг — Visual Basic(Бейсик)

disel

Для того, чтобы сохранить все рабочие листы (в т.ч. и скрытые) в виде отдельных .xls файлов, имена которых будут совпадать с именами рабочих листов — источников, можно использовать нижеприведённый макрос, предварительно указав свою папку для сохранения.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Private Sub WorksheetSaveAsFile()
  
iPath$ = "C:\Мои документы\Архив"
  
If Dir(iPath$, vbDirectory) = "" Then
   MsgBox "Указанная папка " & iPath$ & vbNewLine & _
   "была удалена, перемещена или переименована ", vbExclamation, ""
   Exit Sub
End If
  
On Error GoTo ErrHandler
  
With Application
     .EnableCancelKey = xlDisabled
     .ScreenUpdating = False
     .DisplayAlerts = False
     .EnableEvents = False
     .Calculation = xlManual
     Dim iWorksheet As Worksheet, iHidden As Boolean
     For Each iWorksheet In .ThisWorkbook.Worksheets
         If iWorksheet.Visible <> True Then
            iHidden = True
            iOldVisible& = iWorksheet.Visible
            iWorksheet.Visible = True
         End If
         iWorksheet.Copy
         With .ActiveSheet
              .SaveAs FileName:=iPath$ & "\" & .Name
              .Parent.Close saveChanges:=True
         End With 'Or
         'With .ActiveWorkbook
               '.Close FileName:=iPath$ & "\" & _
               '.ActiveSheet.Name, saveChanges:=True
         'End With
         If iHidden = True Then
            iWorksheet.Visible = iOldVisible&
            iHidden = False 'Not iHidden
         End If
     Next
ErrHandler:
     If Err.Number <> 0 Then
        MsgBox Err.Description, vbCritical, Err.Number
     End If
     .Calculation = xlAutomatic
     .EnableEvents = True
     .DisplayAlerts = True
     .ScreenUpdating = True
     .EnableCancelKey = xlInterrupt
End With
  
End Sub
Если в выбранной папке будет находиться файл с аналогичным именем, то он будет заменён на новый.
Если в рабочем листе есть ячейки, содержащие более 255 символов, то копирование листа приведёт к усечению таких данных до 255 символов (включительно)
Если структура текущей рабочей книги защищена, то копирование скрытых рабочих листов приведёт к возникновению ошибки, которую можно избежать, если добавить соответствующую проверку.

Похожие записи/страницы:

Leave a Comment