• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

break

Status
Niet open voor verdere reacties.
R

Ron321

Gebruiker
Lid geworden
15 jul 2005
Berichten
555
Code: 
On Error GoTo Break

rest van macro

Code: 
Break:
MsgBox "fout"
End Sub

Ik gebruik bovenstaande stukjes macro om een fout in de tussenliggende macro op te vangen.
Alleen verschijnt de msgbox nu ook als de macro wel goed verloopt.

Heeft iemand enig idee hoe ik dat op kan lossen?
 
Je vergat om een Exit Sub te plaatsen voor de Break.

Met vriendelijke groet,


Roncancio
 
Die heb ik al op verschillende plekken geprobeerd in te voegen maar niets helpt.
 
Dit is de hele macro:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$N$12" Or Target.Address = "$N$13" Or Target.Address = "$N$14" Or Target.Address = "$F$12" Then
Dim iPic As Integer
Dim Sh As String
Dim nr As Integer
nr = Range("M5").Value
Dim Afb As String

On Error GoTo Verder1
Afb = "Figuur "
GoTo Go

Verder1:
On Error GoTo verder2
Afb = "Afbeelding "
GoTo Go

verder2:
Afb = "Picture "
Go:

Sh = "gasstraat"
On Error GoTo Break
'alle Figuren uit

' Figuur R300CVIF aan
If nr = 2 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300CVIF").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300KromschroderF aan
If nr = 1 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300KROMF").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300CVIDRF aan
If nr = 3 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300CVIDRF").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300CVI aan
If nr = 5 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300CVI").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300Kromschroder aan
If nr = 4 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300KROM").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300CVIDR aan
If nr = 6 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300CVIDR").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R2700Dungs aan
If nr = 7 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.2800DUNGS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R2700SKP aan
If nr = 8 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.2800SKP").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R2700KROMDR aan
If nr = 9 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.2800DR").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R2700VPS3WEG aan
If nr = 10 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.2700VPS3WEG").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R27003WEG aan
If nr = 11 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.27003WEG").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R2700VPS aan
If nr = 12 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.2700VPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400DR3Kromschroder aan
If nr = 13 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500DR3").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400Kromschroder aan
If nr = 14 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400DR3VPSKromschroder aan
If nr = 21 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500DR3VPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400VPSKromschroder aan
If nr = 22 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500VPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400DR3Dungs aan
If nr = 23 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500DDR3").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400Dungs aan
If nr = 24 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500D").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400DR3VPSDungs aan
If nr = 25 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500DDR3VPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400VPSDungs aan
If nr = 26 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500DVPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300KromschroderDRF aan
If nr = 15 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300KROMDRF").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300KromschroderDR aan
If nr = 16 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300KROMDR").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300CVIFVPS aan
If nr = 17 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300CVIFVPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R300CVIVPS aan
If nr = 18 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.300CVIVPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400DR3SKP aan
If nr = 19 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500SKPDR3").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R3400SKP aan
If nr = 20 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.3500SKP").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R600F aan
If nr = 27 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.600F").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R600 aan
If nr = 28 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.600").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R600FVPS aan
If nr = 29 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.600FVPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R600F aan
If nr = 30 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.600VPS").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R30F aan
If nr = 31 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.30F").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
' Figuur R30 aan
If nr = 32 Then
Sheets("Schema's").Select
    ActiveSheet.Shapes("G.30").Select
    Selection.Copy
    Sheets("gasstraat").Select
    ActiveSheet.Paste
End If
    
If nr >= 1 Then
    Application.DisplayAlerts = False
    Sheets("Schema's").Delete
    Sheets("Voorblad").Select
    Range("D14").Select
    Application.DisplayAlerts = True
End If
End If
Exit Sub
Break:
MsgBox "fout."
End Sub
 
Code: 
Sub Code()
On Error GoTo Break

'Je code

Exit Sub
Break:
MsgBox "fout"
End Sub
Wellicht ten overvloede maar Exit sub moet niet in een lus staan.

Met vriendelijke groet,


Roncancio
 
Hmmm.... Je hebt iets voor ogen met die 'On Error GoTo', maar wat?
Wáár kan deze error op gebaseerd zijn? Dát haal ik niet zo 1, 2, 3 uit je code...

Groet, Leo
 
De opmerking sloeg op het gegeven dat de exit sub niet geactiveerd zou worden.
Dat is in dit geval niet aan de orde.

Je zou in de kantlijn van de code een onderbrekingspunt (F9) kunnen plaatsen, vervolgens in Excel de macro activeren en met F8 stap voor stap door de macro kunnen lopen.

Met vriendelijke groet,


Roncancio
 
Ginger zei:
Hmmm.... Je hebt iets voor ogen met die 'On Error GoTo', maar wat?
Wáár kan deze error op gebaseerd zijn? Dát haal ik niet zo 1, 2, 3 uit je code...

Groet, Leo
Klik om te vergroten...

Omdat op een bepaald moment het blad schema's niet meer aanwezig is.
 
Laatst bewerkt:
Roncancio zei:
Je zou in de kantlijn van de code een onderbrekingspunt (F9) kunnen plaatsen, vervolgens in Excel de macro activeren en met F8 stap voor stap door de macro kunnen lopen.
Klik om te vergroten...
En wat zou ik daarmee kunnen bereiken?
 
Daarmee zou je kunnen zien hoe de code loopt, wanneer de Break wordt geactiveerd etc.
Je code kan overigens een stuk korter en er is een makkelijker manier om te kijken of het werkblad Schema's nog aanwezig is.

Met vriendelijke groet,


Roncancio
 
In eerste instantie wordt de break niet geactiveerd omdat het blad dan nog aanwezig is.
Aan het eind van deze macro wordt het blad verwijderd en als dan later de macro nog een keer getriggerd wordt door een aangepaste waarde wordt de break geactiveerd en moet de msgbox verschijnen.
Maar de msgbox verschijnt nu de 1e keer al.
Voor de rest sta ik open voor verbeteringen.
 
Dat gaat niet.
Te groot en gevoelige info.
Het belangrijkste is een oplossing voor de break.
 
Met onderstaande functie kan op eenvoudige wijze het bestaan v/e werkblad getest worden. Plaats deze in een standaardmodule en roep ze bovenaan je event-macro aan.
Code: 
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function

Je event-macro wordt dan
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$N$12" Or Target.Address = "$N$13" Or Target.Address = "$N$14" Or Target.Address = "$F$12" Then
Dim iPic As Integer
Dim Sh As String
Dim nr As Integer
Dim Afb As String

If WorksheetExists("Schema's") = False Then MsgBox "Fout": Exit Sub
nr = Range("M5").Value
On Error GoTo Verder1
Afb = "Figuur "
GoTo Go

vervolg code
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan