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:
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
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