Excel VBA vbyesno
Hallo,
ich habe folgenden Code...
Sub AbgerundetesRechteck1_Klicken()
Dim wksOrig As Worksheet
Dim wksStore As Worksheet
Dim lngLastRow As Long
Dim xlFileName As String
Set wksOrig = Worksheets("Vorlage")
Set wksStore = Worksheets("Untersuchungen 2016")
ActiveSheet.Unprotect "qs"
Worksheets("Untersuchungen 2016").Unprotect "qs"
With wksStore
lngLastRow = IIf(.Cells(Rows.Count, 4) = "", .Cells(Rows.Count, 4).End(xlUp).Row + 1, Rows.Count)
.Cells(lngLastRow, 1) = wksOrig.Range("A1")
.Cells(lngLastRow, 2) = wksOrig.Range("G5")
.Cells(lngLastRow, 2).NumberFormat = "m/d/yyyy"
.Cells(lngLastRow, 3) = wksOrig.Range("E10")
.Cells(lngLastRow, 4) = wksOrig.Range("A33")
.Cells(lngLastRow, 5) = wksOrig.Range("B33")
.Cells(lngLastRow, 6) = wksOrig.Range("C33")
.Cells(lngLastRow, 7) = wksOrig.Range("D33")
.Cells(lngLastRow, 8) = wksOrig.Range("E33")
.Cells(lngLastRow, 9) = wksOrig.Range("G33")
.Cells(lngLastRow, 10) = wksOrig.Range("H33")
.Cells(lngLastRow, 11) = wksOrig.Range("F33")
.Cells(lngLastRow, 14) = wksOrig.Range("I33")
.Cells(lngLastRow, 15) = wksOrig.Range("J33")
lngLastRow = IIf(.Cells(Rows.Count, 4) = "", .Cells(Rows.Count, 4).End(xlUp).Row + 1, Rows.Count)
.Cells(lngLastRow, 1) = ""
.Cells(lngLastRow, 2) = ""
.Cells(lngLastRow, 3) = ""
.Cells(lngLastRow, 4) = ""
End With
Set wksStore = Nothing
Set wksOrig = Nothing
xlFileName = Range("E10")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\192.168.1.95\Buchhaltung_KH\03-Statistik_KH\99_Untersuchungskosten\Aufträge\AuftragNr." & xlFileName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("Anschrift").PrintOut
Worksheets("Vorlage").Range("A1:F33").PrintOut
With Sheets("Vorlage").Range("E10")
If IsNumeric(.Value) Then
.Value = .Value + 1
End If
End With
a = MsgBox("Soll die Vorlage gelöscht werden?", vbYesNo)
If a = vbYes Then
Range("a17,c17:g17,i17").ClearContents
Range("a18,c18:g18,i18").ClearContents
Range("a19,c19:g19,i19").ClearContents
Range("a20,c20:g20,i20").ClearContents
Range("a21,c21:g21,i21").ClearContents
Range("a22,c22:g22,i22").ClearContents
Range("a23,c23:g23,i23").ClearContents
Range("a24,c24:g24,i24").ClearContents
Range("a25,c25:g25,i25").ClearContents
Range("a26,c26:g26,i26").ClearContents
Range("a27,c27:g27,i27").ClearContents
Range("a28,c28:g28,i28").ClearContents
Range("a29,c29:g29,i29").ClearContents
Range("a30,c30:g30,i30").ClearContents
Range("a31,c31:g31,i31").ClearContents
Range("a32,c32:g32,i32").ClearContents
Range("a33,c33:g33,i33").ClearContents
ActiveSheet.Protect "qs"
Worksheets("Untersuchungen 2016").Protect "qs"
ActiveWorkbook.Save
Else
ActiveSheet.Protect "qs"
Worksheets("Untersuchungen 2016").Protect "qs"
ActiveWorkbook.Save
End If
End Sub
Nur Leider führt er mir den Fett markierten Text nicht aus wenn ich auf meine Button klicke.
Führe ich den Code aus dem Debugger aus funktioniert es.
Könnt Ihr mir sagen Warum?
Mit freundlichen Grüßen
Florian86
ich habe folgenden Code...
Sub AbgerundetesRechteck1_Klicken()
Dim wksOrig As Worksheet
Dim wksStore As Worksheet
Dim lngLastRow As Long
Dim xlFileName As String
Set wksOrig = Worksheets("Vorlage")
Set wksStore = Worksheets("Untersuchungen 2016")
ActiveSheet.Unprotect "qs"
Worksheets("Untersuchungen 2016").Unprotect "qs"
With wksStore
lngLastRow = IIf(.Cells(Rows.Count, 4) = "", .Cells(Rows.Count, 4).End(xlUp).Row + 1, Rows.Count)
.Cells(lngLastRow, 1) = wksOrig.Range("A1")
.Cells(lngLastRow, 2) = wksOrig.Range("G5")
.Cells(lngLastRow, 2).NumberFormat = "m/d/yyyy"
.Cells(lngLastRow, 3) = wksOrig.Range("E10")
.Cells(lngLastRow, 4) = wksOrig.Range("A33")
.Cells(lngLastRow, 5) = wksOrig.Range("B33")
.Cells(lngLastRow, 6) = wksOrig.Range("C33")
.Cells(lngLastRow, 7) = wksOrig.Range("D33")
.Cells(lngLastRow, 8) = wksOrig.Range("E33")
.Cells(lngLastRow, 9) = wksOrig.Range("G33")
.Cells(lngLastRow, 10) = wksOrig.Range("H33")
.Cells(lngLastRow, 11) = wksOrig.Range("F33")
.Cells(lngLastRow, 14) = wksOrig.Range("I33")
.Cells(lngLastRow, 15) = wksOrig.Range("J33")
lngLastRow = IIf(.Cells(Rows.Count, 4) = "", .Cells(Rows.Count, 4).End(xlUp).Row + 1, Rows.Count)
.Cells(lngLastRow, 1) = ""
.Cells(lngLastRow, 2) = ""
.Cells(lngLastRow, 3) = ""
.Cells(lngLastRow, 4) = ""
End With
Set wksStore = Nothing
Set wksOrig = Nothing
xlFileName = Range("E10")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\192.168.1.95\Buchhaltung_KH\03-Statistik_KH\99_Untersuchungskosten\Aufträge\AuftragNr." & xlFileName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("Anschrift").PrintOut
Worksheets("Vorlage").Range("A1:F33").PrintOut
With Sheets("Vorlage").Range("E10")
If IsNumeric(.Value) Then
.Value = .Value + 1
End If
End With
a = MsgBox("Soll die Vorlage gelöscht werden?", vbYesNo)
If a = vbYes Then
Range("a17,c17:g17,i17").ClearContents
Range("a18,c18:g18,i18").ClearContents
Range("a19,c19:g19,i19").ClearContents
Range("a20,c20:g20,i20").ClearContents
Range("a21,c21:g21,i21").ClearContents
Range("a22,c22:g22,i22").ClearContents
Range("a23,c23:g23,i23").ClearContents
Range("a24,c24:g24,i24").ClearContents
Range("a25,c25:g25,i25").ClearContents
Range("a26,c26:g26,i26").ClearContents
Range("a27,c27:g27,i27").ClearContents
Range("a28,c28:g28,i28").ClearContents
Range("a29,c29:g29,i29").ClearContents
Range("a30,c30:g30,i30").ClearContents
Range("a31,c31:g31,i31").ClearContents
Range("a32,c32:g32,i32").ClearContents
Range("a33,c33:g33,i33").ClearContents
ActiveSheet.Protect "qs"
Worksheets("Untersuchungen 2016").Protect "qs"
ActiveWorkbook.Save
Else
ActiveSheet.Protect "qs"
Worksheets("Untersuchungen 2016").Protect "qs"
ActiveWorkbook.Save
End If
End Sub
Nur Leider führt er mir den Fett markierten Text nicht aus wenn ich auf meine Button klicke.
Führe ich den Code aus dem Debugger aus funktioniert es.
Könnt Ihr mir sagen Warum?
Mit freundlichen Grüßen
Florian86
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 305440
Url: https://administrator.de/forum/excel-vba-vbyesno-305440.html
Ausgedruckt am: 22.04.2025 um 13:04 Uhr
2 Kommentare
Neuester Kommentar

Range("a17,c17:g17,i17").ClearContents
Deine Ranges haben keine Definition des Worksheets wo sie wirken sollen. D.h. Sie können unter Umständen auf einem ganz anderen Sheet löschen, wenn das entsprechende Sheet gerade nicht aktiv ist.Du solltest dieses Sheet also definieren :
With wksStore
.Range("a17,c17:g17,i17").ClearContents
'...usw
End with
Gruß skybird
p.s. Und bitte doch mit Codetags posten!