Messagebox Meerdere acties bij VbYes en VbNo

Status
Niet open voor verdere reacties.
I

Ivanhoes

Gebruiker
Lid geworden
6 jun 2015
Berichten
67
Hoi mensen,

Ik wil graag dat een messagebox getoond wordt, indien er wijzigingen plaatsvinden
in een bepaald gedeelte van een werkblad.

Indien er op vbYes geklikt wordt, moet het eerste deel van de code uitgevoerd worden.
Indien er op vbNo geklikt wordt, moet het tweede deel van de code uitgevoerd worden.

Dit tweede deel doet eigenlijk niet veel anders dan het werkblad (kolom A:K) verwijderen
en dus weer leeg maken. En daar zit het probleem: Deze kolommen bevinden zich in
het werkbladgedeelte waarop de code If Intersect van toepassing is. Ik kom hierdoor in een lus terecht
van verwijderen, code uitvoeren, verwijderen, weer code uitvoeren etc...

De volgende code heb ik nu:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("A1:J400")) Is Nothing Then Exit Sub
    
    Yes = MsgBox("OPNEMEN KOPIE", vbYesNo, "WILT U DEZE KOPIE ECHT BEWERKEN?")
    No = MsgBox("OPNEMEN KOPIE", vbYesNo, "WILT U DEZE KOPIE ECHT BEWERKEN?")
    
    If Yes = vbYes Then
        Cells.MergeCells = False
        Cells.HorizontalAlignment = xlLeft
        Cells.VerticalAlignment = xlTop
        Columns("A").ColumnWidth = 13
        Cells.WrapText = True
        Cells.Rows.AutoFit
        Cells.Interior.ColorIndex = xlNone
        Range("A3:J5").ClearContents

    With Sheets("BEWERKEN KOPIE")
        .Range("A2:J401").ClearContents
    End With
    
    With Sheets("OPNEMEN KOPIE")
        .Range("A1:K400").Copy
        Sheets("BEWERKEN KOPIE").Range("A2").PasteSpecial xlPasteValues
    End With
   
    Application.CutCopyMode = False
    
    If vbNo = No Then
            Columns("A:K").Delete
            Range("A1").Value = "KOPIER DE KOPIE IN DEZE CEL. Klik met uw rechtermuisknop op deze cel en kies plakken in het menu"
            Range("A1").Interior.ColorIndex = 6
            Columns("A").ColumnWidth = 16
            Rows("1").RowHeight = 111
            Range("A1").HorizontalAlignment = xlLeft
            Range("A1").VerticalAlignment = xlTop
            Range("A1").WrapText = True
            Range("A1").BorderAround xlEdgeLeft, xlThick
            End If
    End If
     
End Sub

Weet iemand hoe ik ervoor kan zorgen dat de code mbt vbNo niet in een lus terecht komt?

Bekijk bijlage Messagebox Code uitvoeren bij vbYes en vbNo.xlsm

Alvast bedankt,

Ivanhoes
 
Sorry hoor, maar er klopt werkelijk niets van de volgorde waarin je dingen afhandeld. Dat begint al bij het vragen om Yes of No. En waarom doe je dat 2 keer? Tevens zorgt de wijze waarop je je inspringpunten gebruikt om problemen bij het lezen van wat nu eigenlijk waar bij hoort.
 
Laatst bewerkt:
Hoi Edmoor,

En hier komt dan de leek om de hoek kijken. Ik heb nooit een cursus VBA oid gevolgd.
Wat ik weet en kan binnen Excel/VBA komt puur door trial en error, waarbij error het vaak wint.

En daar komt dan dit forum dan weer bij kijken.

In lekentaal zou de code dit (volgens mij, uiteraard) moeten doen (tenminste, dat zou ik willen):

- Toon een msgbox, indien er iets gewijzigd wordt binnen de range A1:J400

- Klik je op "Ja", doe dan dit:
- Bewerk cellen en een kolom naar een bepaalde breedte en hoogte, verwijder de inhoud van
range A3:J5 en geef geen kleur aan de cellen
- Ga naar tabblad Bewerken Kopie en verwijder de inhoud van range A2:J401
- Ga terug naar tabblad Opnemen Kopie en kopieer range A1:K400 naar tabblad Bewerken Kopie in cel A2

- Klik je op "Nee", doe dan dit:
- Verwijder de kolommen A:K
- Plaats in cel A1 een opgemaakte tekst

Ik probeer de code te maken, zoals je normaal gesproken dit handmatig binnen Excel zou doen.
Maar kennelijk moet ik een andere volgorde hanteren?

Hoe dan ook: de onderstaande code werkt op zich goed, behalve dus de code mbt vbNo.
Logischerwijs zou ik denken dat de verwijdering van kolommen A:K zorgt voor een verandering
in de range A1:J400. Deze verandering zorgt door de If....Intersect functie weer voor de activering
van de gehele code. Dat zet dus geen zoden aan de dijk.

Nu probeer ik dus een manier te vinden die de If....Intersect niet-werkend maakt, op het moment
dat voor vbNO gekozen wordt (en omdat ik VBA GOED wil leren, dan ook op de manier zoals het hoort)

Ik hoop dat iemand mij alsnog verder kan helpen.

Groetjes,

Ivanhoes
 
Ok, snap ik, en geen probleem. Maar de La Chouffe heeft het van mij gewonnen nu. Als ik morgenavond weer thuis ben en niemand me voor is geweest zal ik even wat serieuzer kijken :p
 
Een werkblad zonder gegevens is natuurlijk niet echt een voorbeeld, maar je code kan in ieder geval een stuk simpeler:
Code: 
    If Intersect(Target, Range("A1:J400")) Is Nothing Then Exit Sub
    Antwoord = MsgBox("OPNEMEN KOPIE", vbYesNoCancel, "WILT U DEZE KOPIE ECHT BEWERKEN?")
    If Antwoord = vbYes Then
        With Cells
            .MergeCells = False
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .WrapText = True
            .Rows.AutoFit
            .Interior.ColorIndex = xlNone
        End With
        Columns("A").ColumnWidth = 13
        Range("A3:J5").ClearContents
        Sheets("BEWERKEN KOPIE").Range("A2:J401") = Sheets("OPNEMEN KOPIE").Range("A1:K400")
    ElseIf Antwoord = No Then
        Columns("A:K").Delete
        Range("A1").Value = "KOPIER DE KOPIE IN DEZE CEL. Klik met uw rechtermuisknop op deze cel en kies plakken in het menu"
        Range("A1").Interior.ColorIndex = 6
        Columns("A").ColumnWidth = 16
        Rows("1").RowHeight = 111
        Range("A1").HorizontalAlignment = xlLeft
        Range("A1").VerticalAlignment = xlTop
        Range("A1").WrapText = True
        Range("A1").BorderAround xlEdgeLeft, xlThick
    Else
        Exit Sub
    End If
 
Hoi mensen,

Alvast bedankt voor de reacties!

@Edmoor: Ja, zo'n La Chouffe........dat wilde ik ook wel!

@Octafish: Ik heb alsnog een voorbeeld gemaakt, met een kopie uit het bestand die ik wil
kopiëren in dit bestand. Uiteraard zijn de waarden in de kopie totale onzin,
maar de vorm is wel degelijk de vorm die normaal gesproken gebruikt wordt.

Ik heb ook meteen de door jou gemaakte code gebruikt. En getest. En gezien dat de code niet doet
wat hij moet doen. :(
De code blijft namelijk maar komen met de msgbox, ook al zou de code eerst moeten worden
uitgevoerd en daarna moeten stoppen nadat je op "Yes" of "No" geklikt hebt. Na een aantal keer
klikken op "Cancel" wordt het stukje code mbt de opmaak in cel A1 wel uitgevoerd en wordt
de code daarna ook gestopt.

En dat begrijp ik dan weer niet, want volgens mij is jouw code vrijwel hetzelfde als mijn code.
Je hebt de code netter/beter en in de goede volgorde gemaakt dan mijn code, maar hele grote
verschillen zie ik niet?

Waarom krijg ik de code niet goed genoeg werkend? Waar ligt dit dan toch aan?


Groetjes,

Ivanhoes.
 

Bijlagen

  • Messagebox Code uitvoeren bij vbYes en vbNo 2.xlsm
    20,5 KB · Weergaven: 34
Dat komt door de wijzigingen die in de target range gebeuren. Die triggeren nogmaals het uitvoeren van dezelfde code voordat deze gereed is. Je kan dat onderdrukken met Application.EnableEvents = False
Probeer het eens zo:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("A1:J400")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    
    Select Case MsgBox("OPNEMEN KOPIE", vbYesNoCancel, "WILT U DEZE KOPIE ECHT BEWERKEN?")
        Case vbYes
            With Cells
                .MergeCells = False
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlTop
                .WrapText = True
                .Rows.AutoFit
                .Interior.ColorIndex = xlNone
            End With
            Columns("A").ColumnWidth = 13
            Range("A3:J5").ClearContents
            Sheets("BEWERKEN KOPIE").Range("A2:J401") = Sheets("OPNEMEN KOPIE").Range("A1:K400").Value
            
        Case vbNo
            Columns("A:K").Delete
            Columns("A").ColumnWidth = 16
            Rows("1").RowHeight = 111
            With Range("A1")
                .Value = "KOPIER DE KOPIE IN DEZE CEL. Klik met uw rechtermuisknop op deze cel en kies plakken in het menu"
                .Interior.ColorIndex = 6
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlTop
                .WrapText = True
                .BorderAround xlEdgeLeft, xlThick
            End With
        End Select
        
    Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Ik vermoed:

Sheets("BEWERKEN KOPIE").Range("A2:J401") = Sheets("OPNEMEN KOPIE").Range("A1:K400").Value
 
Niet naar gekeken maar ik ga er voor het gemak van uit dat je gelijk hebt :)
 
Hoi mensen,

Ik heb er werkelijk geen woorden voor. Het werkt precies zoals ik wilde dat het zou moeten gaan!
En snel dat het gaat! Bedankt daarom voor de hulp.

En weer heb ik iets geleerd. Ik weet nu bijvoorbeeld dat ik EnableEvents kan gebruiken om te onderdrukken.
Over de volgorde van de codes heb ik het nog maar even niet, dat is langere-termijn-werk.

Nogmaals: het werkt en dus bedankt allen. Nu heb ìk tijd voor een La Chouffe!

Groetjes,

Ivanhoes.
 
Proost! :D
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan