Hi all
I'm working on someone else's macro, on a prodcution machine which I'm not allowed to stop.
I had it running this morning, then stupidly didn't save it and it later crashed and lost it all.
Now when I try and put it back in I am getting an error message. But because there is a error subroutine in the exising macro, I am getting this instead of the 'real' error. And the debugger ends up in the error subroutine instead of where it should be so I'm no wiser as to the problem.
If it goes wrong there's nothing I can do as they then need the machine for production so I just have to give up and go away.
I'd like, within my add-on macro, to say ignore the error subroutine but not sure how. I've tried turning off the error subroutine but this also buggered the macro up. If I can just get it to show me where exactly its going wrong I can sort it out away from the machine.
I've added the error subroutine:
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnumm As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnumm = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnumm
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
MsgBox ("Did you select the correct type for the roll. The macro tried to open a file that is not there. See Ewan/Lee/Sharon. The macro will now give an error message saying 'Path not found'. Click on 'End' then correctly select the roll type and re-run. Or, if you click on 'debug' you will see 'Error errnumm' highlighted. Click on the 'STOP' button at the top of that screen, close that screen down, go back to the spreadsheet, correctly select the file type and re-run. If this message appears again, seek help from Ewan/Lee/Sharon.")
Error errnumm
End Select
End Function
(ps I'm getting the "did you select the correct type of roll...." message)
And here is my add-on macro just in case anyone can see any obvious reason why its not working
Sub labelprint()
Dim label, x, checkroll
MsgBox "into labelprint macro"
'pick up checkroll from macro file
Windows("csvfilecheckmacro_31102005.xls").Activate
checkroll = Range("e40").Value
'back to basefile
ActiveWindow.ActivateNext
Sheets("data").Activate
'pick up label number
label = Range("e3").Value
Sheets("result").Activate
MsgBox "then tries to open label file"
'open relevant label file
If checkroll = "13" Or checkroll = "16" Then
If IsFileOpen("c:\PIP2RollBoxLabels.xls") Then
Windows("PIP2RollBoxLabels.xls").Activate
Else
Workbooks.Open filename:="c:\PIP2RollBoxLabels.xls"
End If
Sheets("single PIP2 labels").Activate
End If
If checkroll = "102" Or checkroll = "105" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("single black").Activate
End If
If checkroll = "103" Or checkroll = "106" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Colour").Activate
End If
If checkroll = "104" Or checkroll = "107" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Yellow").Activate
End If
'put label number in and print
Range("b6").Value = label
x = MsgBox("Is this the correct label number? " & label & Chr(13) & "If this is correct and you are ready to print click OK or press enter." & Chr(13) & "Click cancel to exit", vbOKCancel)
Range("a10.f30").Select
If x = vbOK Then Selection.PrintPreview
End Sub
Any help appreciated, I've been and down the stairs so many times today and I'm knackered!!
Cath
I'm working on someone else's macro, on a prodcution machine which I'm not allowed to stop.
I had it running this morning, then stupidly didn't save it and it later crashed and lost it all.
Now when I try and put it back in I am getting an error message. But because there is a error subroutine in the exising macro, I am getting this instead of the 'real' error. And the debugger ends up in the error subroutine instead of where it should be so I'm no wiser as to the problem.
If it goes wrong there's nothing I can do as they then need the machine for production so I just have to give up and go away.
I'd like, within my add-on macro, to say ignore the error subroutine but not sure how. I've tried turning off the error subroutine but this also buggered the macro up. If I can just get it to show me where exactly its going wrong I can sort it out away from the machine.
I've added the error subroutine:
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnumm As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnumm = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnumm
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
MsgBox ("Did you select the correct type for the roll. The macro tried to open a file that is not there. See Ewan/Lee/Sharon. The macro will now give an error message saying 'Path not found'. Click on 'End' then correctly select the roll type and re-run. Or, if you click on 'debug' you will see 'Error errnumm' highlighted. Click on the 'STOP' button at the top of that screen, close that screen down, go back to the spreadsheet, correctly select the file type and re-run. If this message appears again, seek help from Ewan/Lee/Sharon.")
Error errnumm
End Select
End Function
(ps I'm getting the "did you select the correct type of roll...." message)
And here is my add-on macro just in case anyone can see any obvious reason why its not working
Sub labelprint()
Dim label, x, checkroll
MsgBox "into labelprint macro"
'pick up checkroll from macro file
Windows("csvfilecheckmacro_31102005.xls").Activate
checkroll = Range("e40").Value
'back to basefile
ActiveWindow.ActivateNext
Sheets("data").Activate
'pick up label number
label = Range("e3").Value
Sheets("result").Activate
MsgBox "then tries to open label file"
'open relevant label file
If checkroll = "13" Or checkroll = "16" Then
If IsFileOpen("c:\PIP2RollBoxLabels.xls") Then
Windows("PIP2RollBoxLabels.xls").Activate
Else
Workbooks.Open filename:="c:\PIP2RollBoxLabels.xls"
End If
Sheets("single PIP2 labels").Activate
End If
If checkroll = "102" Or checkroll = "105" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("single black").Activate
End If
If checkroll = "103" Or checkroll = "106" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Colour").Activate
End If
If checkroll = "104" Or checkroll = "107" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Yellow").Activate
End If
'put label number in and print
Range("b6").Value = label
x = MsgBox("Is this the correct label number? " & label & Chr(13) & "If this is correct and you are ready to print click OK or press enter." & Chr(13) & "Click cancel to exit", vbOKCancel)
Range("a10.f30").Select
If x = vbOK Then Selection.PrintPreview
End Sub
Any help appreciated, I've been and down the stairs so many times today and I'm knackered!!
Cath