florian86
Goto Top

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

Content-ID: 305440

Url: https://administrator.de/forum/excel-vba-vbyesno-305440.html

Ausgedruckt am: 22.04.2025 um 13:04 Uhr

Florian86
Florian86 26.05.2016 um 09:42:32 Uhr
Goto Top
aso eins noch die Abfrage vbYesNo kommt aber der Löschvorgang funktioniert nicht.
Wie gesagt aus dem Debugger heraus mit F8 durchlaufen funktioniert es.

Nehme ich den Code auf einen extra Button funktioniert es auch.

Aber warum nicht mit den ganzen anderen Rest?

MfG

Florian
129413
Lösung 129413 26.05.2016 aktualisiert um 10:04:14 Uhr
Goto Top
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
Ich wusste jetzt nicht auf welchem Sheet du die Zellen löschen willst aber das Prinzip sollte jetzt klar sein.

Gruß skybird

p.s. Und bitte doch mit Codetags posten!