Good morning, all!
I have the following code snippet in a longer piece of code developed with your help:
With ActiveWorkbook
'.Sheets(Sheets.Count).Protect Not sure I need this? Remove?
.Sheets(Sheets.Count).Name = LstPrint.List(x)
If .HasVBProject Then
FileFormatNum = 52
Else
FileFormatNum = 51
End If
.SaveAs FolderName & "\" & LstPrint.List(x), FileFormatNum
.Close False
End With
It creates a folder in which to deposit one or more worksheets from the master workbook. What I would like to do is to add a checkbox to my user form (this bit I can do) that, when checked, will override the above section of code and instead ask the user to browse to an existing folder. Ideally I'd need this to happen at the start of the routine so that it only has to be done once, and not for each sheet generated. If it's not easy to do, I can live without it, but it would be a nice refinement.
To put this in context, here's the complete code:
Private Sub CheckBox1_Click()
Dim N As Single
If CheckBox1.Value = True Then
For N = 0 To LstPrint.ListCount - 1
LstPrint.Selected(N) = True
Next N
Else
For N = 0 To LstPrint.ListCount - 1
LstPrint.Selected(N) = False
Next N
End If
End Sub
Private Sub CheckBox2_Click()
End Sub
Private Sub CheckBox3_Click()
End Sub
Private Sub UserForm_Initialize()
Dim sh As Worksheet
With LstPrint
.Clear
For Each sh In Worksheets 'Sets worksheets to be excluded from selection list
If sh.Name <> "1. Staff List & Subjects" And sh.Name <> "2. Staff Allocation Checklist" And sh.Name <> "3. Roles & Responsibilities" And sh.Name <> "Grid Template" Then .AddItem sh.Name
Next
End With
End Sub
Private Sub CmdPrint_Click()
Dim DateString As String
Dim FolderName As String
Dim x As Long 'Sets the count of workbooks selected for export
Dim i As Long 'Sets the workbook to scroll all worksheets back to the top before exporting
Dim FileFormatNum As Long
Application.ScreenUpdating = False
DateString = Format(Now, "dd mmmm yyyy")
FolderName = "C:\Users\Alison\OneDrive - Royal Hospital School\Documents\Timetable WIP\2019-20\Staffing Grids for HoDs" & " " & DateString
For x = 0 To LstPrint.ListCount - 1
For i = 1 To ThisWorkbook.Sheets.Count
Application.Goto reference:=Sheets(i).Range("A1"), Scroll:=True
Next i
'///// COPY SECTION /////
If LstPrint.Selected(x) = True Then
Application.CopyObjectsWithCells = False
With Sheets(LstPrint.List(x))
.Unprotect
.Copy
End With
'///// PASTE SECTION /////
Application.CopyObjectsWithCells = False
With Sheets(Sheets.Count)
.Unprotect
.Range("H1").Value = LstPrint.List(x)
.Range("A1").Value = .Range("A1").Value
.Range("B2:U4").Value = .Range("B2:U4").Value
.Range("B94:B104").Value = .Range("B94:B104").Value
.Range("E94:U104").Value = .Range("E94:U104").Value
If CheckBox3.Value = True Then .Range("E94:U103").Locked = False
If CheckBox2.Value = False Then .Protect Password:="Babelfish"
End With
'///// EXPORT SECTION /////
With ActiveWorkbook
'.Sheets(Sheets.Count).Protect Not sure I need this? Remove?
.Sheets(Sheets.Count).Name = LstPrint.List(x)
If .HasVBProject Then
FileFormatNum = 52
Else
FileFormatNum = 51
End If
.SaveAs FolderName & "\" & LstPrint.List(x), FileFormatNum
.Close False
End With
'///// TIDY WORKBOOK SECTION /////
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = LstPrint.List(x) & " (#)" Then
Application.DisplayAlerts = False
Worksheets(LstPrint.List(x) & " (#)").Delete
Application.DisplayAlerts = True
End If
Next Sheet
End If
Next
'///// RESET FOCUS SECTION /////
Application.ScreenUpdating = True
Unload Me 'Unloads user form
Application.Goto Sheets("1. Staff List & Subjects").Range("A1") 'Returns focus to first sheet of workbook
Call Shell("explorer.exe " & FolderName, vbNormalFocus) 'Opens folder containing exported workbooks
End Sub
Bookmarks