Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1320to1324
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
MsgBox: Abfrage ob Druckbereich ja nein
16.07.2013 11:30:36
Bernd
Hallo zusammen,
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: MsgBox: Abfrage ob Druckbereich ja nein
16.07.2013 11:45:14
Rudi
Hallo,
so sollte das klappen:
Private Sub cmdBaufi_drucken_Click()
Dim blnKFW As Boolean
Application.ScreenUpdating = False
blnKFW = MsgBox("mit KFW?", vbYesNo) = vbYes
Sheets("Wohnen").Range("B2:I3").Copy Sheets("Baufi drucken").Range("B1")
Sheets("Baufi").Range("C1:M2").Copy Sheets("Baufi drucken").Range("B9")
'++++++++++++++++++++++++++++++++++++++++++++ MsgBox mit oder ohne Sheet "KfW"
If blnKFW Then
Sheets("KfW").Range("J1:O2").Copy Sheets("Baufi drucken").Range("B20")
End If
Application.CutCopyMode = False
With Sheets("Baufi drucken")
With .Columns("B:B")
With .Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With .Columns("C:C")
With .Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End With
Sheets("Beleihungswert").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Sheets("Tilgungsplan").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Wenn oben nein, hier  _
auch nein
If blnKFW Then
Sheets("Tilgungsplan KfW").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End If
Sheets("Baufi drucken").Range("B1:C25").ClearContents
End Sub

Gruß
Rudi

Anzeige
@ Rudi,...PasteSpecial...Transpose=True
16.07.2013 12:06:38
Matze
Hi Rudi,..
in seinen geposteten Codezeilen hat er doch mit PastSpecial gearbeitet,
das solltest du ihm zumindest auch so wiedergeben. :-))
Matze

AW: @ Rudi,...PasteSpecial...Transpose=True
16.07.2013 12:09:09
Bernd
Danke Matze für deinen Hinweis.

AW: MsgBox: Abfrage ob Druckbereich ja nein
16.07.2013 12:06:56
Bernd
Hallo Rudi,
wieder mal schneller als die Polizei erlaubt, Danke, Danke!!!
Allerdings hast du eine Kleinigkeit übersehen und zwar werden die ersten Daten "Transponiert"
Kannst du das noch einbauen?
Gruß
Bernd

AW: MsgBox: Abfrage ob Druckbereich ja nein
16.07.2013 12:11:04
Rudi
Hallo,
hab ich glatt übersehen.
Private Sub cmdBaufi_drucken_Click()
Dim blnKFW As Boolean
Application.ScreenUpdating = False
blnKFW = MsgBox("mit KFW?", vbYesNo) = vbYes
Sheets("Wohnen").Range("B2:I3").Copy
Sheets("Baufi drucken").Range("B1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Sheets("Baufi").Range("C1:M2").Copy
Sheets("Baufi drucken").Range("B9").PasteSpecial Paste:=xlPasteAll, Transpose:=True
'++++++++++++++++++++++++++++++++++++++++++++ MsgBox mit oder ohne Sheet "KfW"
If blnKFW Then
Sheets("KfW").Range("J1:O2").Copy
Sheets("Baufi drucken").Range("B20").PasteSpecial Paste:=xlPasteAll, Transpose:=True
End If
Application.CutCopyMode = False
Gruß
Rudi

Anzeige
AW: MsgBox: Abfrage ob Druckbereich ja nein
16.07.2013 12:37:41
Bernd
Hallo Rudi,
passt wie immer!!!
Ich glaube, ich hätte es nicht besser machen können, ha, ha ;-)
Danke, Danke, Danke!!!
Gruß
Bernd

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige