MsgBox: Abfrage ob Druckbereich ja nein
16.07.2013 11:30:36
Bernd
nachfolgenden Code habe ich gerade mit Recorder aufgezeichnet.
Allerding soll nicht immer alles gedruckt werden sondern, einmal mit Tabelle "KfW" und Tabelle "Tilgungsplan Kfw" einmal ohne. Nun habe ich versucht eine Abfrage (an den mit Kreuzen dargestellten Code) mit Msgbox einzubauen "Soll Kfw mit gedruckt werden, ja oder nein?", scheitere aber immer.
Kann mir vielleicht jemand behilflich sein?
Danke schon mal im Voraus!!!
Gruß
Bernd
Hier mein Code:
Private Sub cmdBaufi_drucken_Click()
Application.ScreenUpdating = False
Sheets("Wohnen").Select
Range("B2:I3").Select
Selection.Copy
Sheets("Baufi drucken").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Baufi").Select
Range("C1:M2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Baufi drucken").Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'++++++++++++++++++++++++++++++++++++++++++++ MsgBox mit oder ohne Sheet "KfW"
Sheets("KfW").Select
Range("J1:O2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Baufi drucken").Select
Range("B20").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'++++++++++++++++++++++++++++++++++++++++++++
Columns("B:B").Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("C:C").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("Beleihungswert").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("Tilgungsplan").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Wenn oben nein, hier auch nein
Sheets("Tilgungsplan KfW").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sheets("Baufi drucken").Select
Range("B1:C25").Select
Selection.ClearContents
Range("B1").Select
Application.ScreenUpdating = True
End Sub
Private Sub cmdTilgungsplanKfW_Click()
Application.ScreenUpdating = False
Sheets("Tilgungsplan KfW").Select
Range("A1:E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$721").AutoFilter Field:=1, Criteria1:="<=" & Sheets("KfW").Range("N2"), _
Operator:=xlAnd
With ListBox3
.ColumnCount = 5
.ColumnWidths = "1,1cm;3cm;1,8cm;2,4cm;3cm"
.ColumnHeads = True
With Sheets("Tilgungsplan KfW")
ListBox3.RowSource = Range(.Range("A2"), .Cells(Rows.Count, "E").End(xlUp)).Address(, , , True)
End With
End With
Application.ScreenUpdating = True
End Sub
Anzeige