Error 1004 caused during printing

[ABabeNChrist]

I have a Workbook with numerous sheets that are used for reports. I can print any sheet in whatever combination I choose with not a problem, except for when I select sheet named Summary. I then get this error.

Summary Error.JPG

It still seems to print the Summary sheet, but I still get this error, I noticed that all of my sheets except for sheet named “_” are unhidden, which makes me think the print code is not completing its cycle.
I thought since the error was referring to protection, I then removed the sheet protection and unhide Summary sheet and then ran the code, but again same error.
Here is the code I am using

Code: Select all

Dim wssheet As Worksheet

 Application.ScreenUpdating = False
   For Each wssheet In ActiveWorkbook.Worksheets
     If Not wssheet.Name = "_" Then wssheet.Visible = xlSheetVisible
Next wssheet
     If CheckBox1.Value = True Then Sheets("Cover Page").Select Replace:=True
     If CheckBox2.Value = True Then Sheets("Client Information").Select Replace:=False
     If CheckBox3.Value = True Then Sheets("Utilities").Select Replace:=False
     If CheckBox4.Value = True Then Sheets("Grounds").Select Replace:=False
     If CheckBox5.Value = True Then Sheets("Structure and Exterior").Select Replace:=False
     If CheckBox6.Value = True Then Sheets("Garage").Select Replace:=False
     If CheckBox7.Value = True Then Sheets("Roof").Select Replace:=False
     If CheckBox8.Value = True Then Sheets("Fireplace and Attic").Select Replace:=False
     If CheckBox9.Value = True Then Sheets("Bedroom(s)").Select Replace:=False
     If CheckBox10.Value = True Then Sheets("Bathroom(s)").Select Replace:=False
     If CheckBox11.Value = True Then Sheets("Interior").Select Replace:=False
     If CheckBox12.Value = True Then Sheets("Kitchen").Select Replace:=False
     If CheckBox13.Value = True Then Sheets("Kitchen Appliances").Select Replace:=False
     If CheckBox14.Value = True Then Sheets("Heating and Cooling").Select Replace:=False
     If CheckBox15.Value = True Then Sheets("Water Heater").Select Replace:=False
     If CheckBox16.Value = True Then Sheets("Pool Spa").Select Replace:=False
     If CheckBox17.Value = True Then Sheets("Summary").Select Replace:=False
     If CheckBox18.Value = True Then Sheets("Additional Photos").Select Replace:=False

ActiveWindow.SelectedSheets.PrintOut
  
    
   For Each wssheet In ActiveWorkbook.Worksheets
     If Not wssheet.Name = "_" Then wssheet.Visible = xlSheetHidden
Next wssheet
 Application.ScreenUpdating = True

[HansV]

The code that you posted does not unprotect worksheets. Do you have code in the worksheet module for the Summary sheet that unprotects it?

[ABabeNChrist]

Hi Hans
No, the only thing that the Summary uses is this macro

Code: Select all

'USE-COLOR AND BOLD TEXT STRINGS WITHIN TEXT EXCEL VBA
'BROUGHT TO YOU BY WWW.PROGRAMMINGLIBRARY.COM
'CREATED BY MARK SLOBODA

'************************* DEC VARS *******************************
    Dim myCell As Range
    Dim myRng As Range
    Dim FirstAddress As String
    Dim iCtr As Long
    Dim letCtr As Long
    Dim startrow As Long    'BEGINNING OF RANGE
    Dim endrow As Long    ' END OF RANGE
    Dim startcolumn As Integer    'BEGINNING COLUMN
    Dim endcolumn As Integer    'END COLUMN

    '************************* SET VALUES*****************************
    'DUMMY VALUES - COULD BE PASSED
    startrow = 8
    endrow = 125
    startcolumn = 1
    endcolumn = 50

    'SET UP RANGE YOU ARE COLORING AND BOLDING -YOU COULD MODIFY TO PASS VALUE TO
    Set myRng = Range(Cells(startrow, startcolumn), Cells(endrow, endcolumn))

    'SET UP ARRAY WITH WORDS YOU WANT TO COLOR AND BOLD - YOU COULD PUSH VALUES FROM A LISTBOX TO THIS ARRAY
    myWords = Array("Safety Hazard", "Safety Concern", "Safety Issue", _
                    "Danger - Qualified Professional Only", "Dangerous")

    'BEGIN MASTER LOOP---------------------------------------
    For iCtr = LBound(myWords) To UBound(myWords)
        'ERROR FOUND-BYPASS
        On Error Resume Next
        With myRng
            Set myCell = .Find(What:=myWords(iCtr), After:=.Cells(1), _
                               LookIn:=xlValues, LookAt:=xlPart, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlNext, _
                               MatchCase:=False)
            'LOGIC CHECK
            If Not myCell Is Nothing Then
                FirstAddress = myCell.Address

                Do
                    For letCtr = 1 To Len(myCell.Value)
                        If StrComp(Mid(myCell.Value, letCtr, _
                                       Len(myWords(iCtr))), _
                                       myWords(iCtr), vbTextCompare) = 0 Then
                            myCell.Characters(Start:=letCtr, _
                                              Length:=Len(myWords(iCtr))) _
                                              .Font.ColorIndex = 3
                        End If

                    Next letCtr

                    'GET NEXT ADDRESS
                    Set myCell = .FindNext(myCell)

                Loop While Not myCell Is Nothing _
                     And myCell.Address <> FirstAddress
            End If
        End With
    Next iCtr
End Sub

[HansV]

There must be some code that tries to unprotect the Summary sheet. Could it be in the ThisWorkbook module?

[ABabeNChrist]

Hi Hans
There is nothing in the Workbook module
Here is all the code that is within the Summary sheet

Code: Select all

Option Explicit

Private Sub CommandButton33_Click()
    ActiveSheet.Range("AM5").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, Password:=""
    Worksheets("Summary").Visible = xlSheetHidden
    UserForm8.Show
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Use the Range to select desired cells
    ActiveSheet.Unprotect Password:=""
    If Not Intersect(Target, Range("A6")) Is Nothing Then
        Target.Select
        AutoFitMergedCellRowHeight
    End If
    Call ColorandBold
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, Password:=""
End Sub

Private Sub Worksheet_Deactivate()
ColorandBold
End Sub

Private Sub Worksheet_Activate()
    ActiveSheet.Unprotect Password:=""
      Call ColorandBold 'Macro
      Worksheets("Summary").ScrollArea = "A1:AM125"
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, _
    Password:="", UserInterfaceOnly:=True
End Sub

I added unprotect and protect when running macro, or else macro seemed to not run

[HansV]

You should remove all lines that unprotect and protect the sheet. They are not needed when you have protected the sheet one time with UserInterfaceOnly:=True.

[ABabeNChrist]

Hi Hans
It seemed to solve the problem, I removed the Unprotect and Protect from all the Summary sheet code except for first line of code, which hides sheet and opens userform. I then added the

Code: Select all

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, _
     Password:="", UserInterfaceOnly:=True

I thought putting it here would be better because whenever a modification is needed to summary sheet and protection is removed, that it will reset the needed protection.
here is how the code appears on my Summary sheet

Code: Select all

Option Explicit

Private Sub CommandButton33_Click()
    ActiveSheet.Range("AM5").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, _
    Password:="", UserInterfaceOnly:=True
    Worksheets("Summary").Visible = xlSheetHidden
    UserForm8.Show
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Use the Range to select desired cells
    If Not Intersect(Target, Range("A6")) Is Nothing Then
        Target.Select
        AutoFitMergedCellRowHeight
    End If
    Call ColorandBold
End Sub

Private Sub Worksheet_Deactivate()
ColorandBold
End Sub

Private Sub Worksheet_Activate()
      Call ColorandBold 'Macro
      Worksheets("Summary").ScrollArea = "A1:AM125"
End Sub