Sub CreateIndividReports()
Dim count As Integer
Dim Max As Integer
Dim SaveFilePath As String
Dim SaveFileName As String
Dim NewWorksheetName As String
Dim worksheetUsed As String
Application.Goto Reference:="max"
Max = ActiveCell.Value
For count = 1 To Max 'replace 2 with max for real file
Application.Goto Reference:="SaveFilePath"
SaveFilePath = ActiveCell.Value
Application.Goto Reference:="SaveFileName"
SaveFileName = ActiveCell.Value
SaveFilePath = SaveFilePath & SaveFileName & ".xlsx"
Application.Goto Reference:="NewWorksheetName"
NewWorksheetName = ActiveCell.Value
Sheets("Form for NE").Select
'Set curcell = Worksheets("Raw-Data").Cells(clg, 1)
'If curcell = "" Then Exit Sub
'EEName = curcell.Value
'Set curcell = Worksheets("raw-data").Cells(clg, 46)
'worksheetUsed = curcell.Value
'Sheets(worksheetUsed).Activate
'Range("AD12").Activate
'Range("AD12").Value = EEName
'Sheets(worksheetUsed).Select
Sheets("Form for NE").Copy
Cells.Select
Range("A8").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'RemoveAllMacros
'Name = Range("AD12").Value
ActiveSheet.Name = NewWorksheetName
ActiveWorkbook.SaveAs Filename:=SaveFilePath
'ActiveWorkbook.SaveAs Filename:="H:\Comp COE\Exec Comp\2013 CLG Comp Planning\CLG Comp Sheets\" & Name
Print2PDF
ActiveWorkbook.Close
Application.Goto Reference:="count"
ActiveCell.Value = count + 1
Next count
End Sub
Sub Print2PDF()
Dim oSheet As Worksheet
Dim oPDF As PdfDistiller
Dim TmpPSFile As String
Dim PDFFile As String
Dim SaveFilePathPDF As String
Dim SaveFileName As String
Range("BT1").Select
SaveFilePathPDF = ActiveCell.Value
'SaveFileName = ActiveSheet.Name
'SaveFilePathPDF = SaveFilePathPDF & SaveFileName & ".pdf"
Set oSheet = ActiveSheet
Set oPDF = New PdfDistiller
TmpPSFile = "c:\TmpPSFile.ps"
PDFFile = SaveFilePathPDF
End Sub
Sub RemoveAllMacros()
'will remove all VBA code, including ThisWorkbook, Sheets, & XL4, from
'the active workbook
Dim VBAProj As Object, VBComps As Object, VBComp As Object
Dim ws As Worksheet, dlg As DialogSheet
Const strTitLock As String = "Project locked!"
Const strMsgLock As String = "Cannot delete code from a locked project."
Const strTitle As String = "WARNING!!! - Are you sure?"
Const strMsg1 As String = _
"You are about to delete ALL VBA code in the activeworkbook."
Const strMsg2 As String = "Do you wish to proceed?"
If VBPLocked(ActiveWorkbook) = True Then
MsgBox prompt:=strMsgLock, Buttons:=vbCritical + vbOKOnly, Title:=strTitLock
Exit Sub
End If
'use UDF to check if project is locked before proceeding
'If MsgBox(prompt:=strMsg1 & vbNewLine & vbNewLine & strMsg2, _
' Buttons:=vbExclamation + vbYesNo, Title:=strTitle) = vbNo Then Exit Sub
'check that user wishes to proceed
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
'just in case!
Set VBAProj = ActiveWorkbook.VBProject
Set VBComps = VBAProj.VBComponents
For Each VBComp In VBComps
With VBComp
Select Case .Type
Case 1, 2, 3
'1=vbext_ct_StdModule, 2=vbext_ct_ClassModule, 3=vbext_ct_MSForm
VBComps.Remove VBComp
Case Else
'ThisWorkbook, Sheets
.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
End Select
End With
Next
End If
Application.DisplayAlerts = False
For Each ws In Excel4MacroSheets
ws.Delete
Next
For Each dlg In DialogSheets
dlg.Delete
Next
Application.DisplayAlerts = True
'get rid of old stuff too
Set VBAProj = Nothing: Set VBComps = Nothing: Set VBComp = Nothing
Set ws = Nothing: Set dlg = Nothing
End Sub
Function VBPLocked(ByVal wb As Workbook) As Boolean
'check whether the project is locked
Dim VBAProj As Object
Set VBAProj = wb.VBProject
VBPLocked = VBAProj.Protection
'0 (False) = unlocked, 1 (True) = locked
Set VBAProj = Nothing
End Function
