Hello
I have the following VBA coding in my workbook. It was working fine but now I'm getting a Run time error 438 message "Object doesn't support this property or method". It lets me choose "end" and will then continue to print the worksheet, but I need the workbook to be fully working before I can let it loose on my colleagues! I know that some people will get a bit freaked by a run time error message!
I have no idea where to start looking for the error that's making this message appear as the run time error message box is greying out the debug button.
If anyone can help me, I'd really appreciate it.
Any changes to the coding need to be compatible with excel versions 2003, 2007 & 2010.
Many thanks.
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.Unprotect Password:="psswd"
Dim Start As Boolean
Dim Rng1 As Range
Dim Prompt As String, RngStr As String
Dim cell As Range
'set your ranges here
'Rng1 is on sheet "Expense Claim Form" and cells b3:b6, e3:e5, h3, l3, n5:n6
Set Rng1 = Sheets("Expense Claim Form").Range("b3:b6,e3:e5,h3,l3,n5:n6")
'message is returned if there are blank cells
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "You will not be able " & _
"to print the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete and have been highlighted red:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For Each cell In Rng1
If cell.Value = vbNullString Then
cell.Interior.ColorIndex = 3 '** color red
If Start Then RngStr = RngStr & cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & cell.Address(False, False) & ", "
Else
cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
Start = True
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Else
'saves the changes before closing
ThisWorkbook.Print
Cancel = False
End If
Set Rng1 = Nothing
ActiveSheet.Protect Password:="psswd"
End Sub
Private Sub Workbook_open()
Run ("colour")
ActiveSheet.Protect Password:="psswd"
MsgBox "If you are opening a previously saved version of this " & _
"Expense Claim Form, please ensure that your personal & car details " & _
"are correct prior to completing the rest of the form. "
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E3:E5")) Is Nothing Then Exit Sub
If Target.Row = 3 Then
Range("E4:E5").ClearContents
ElseIf Target.Row = 4 Then
Range("E5").ClearContents
End If
End Sub
Bookmarks