Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen

Druckmenü | Herbers Excel-Forum


Betrifft: Druckmenü von: Snewi
Geschrieben am: 22.02.2012 09:28:30

Hallo,

ich habe für ein Druckmenü folgenden Syntax:


Private Sub cmdAbbrechen_Click()
    Unload Me
End Sub

Private Sub cmdDrucken_Click()
Dim chk As Control
Dim strSh As String

Application.ScreenUpdating = False
   For Each chk In Me.Controls
      If TypeOf chk Is MSForms.CheckBox Then
         If chk Then 'angehakt?
            strSh = strSh & chk.Caption & ","
         End If
      End If
   Next
   If strSh = "" Then Exit Sub
   strSh = Left(strSh, Len(strSh) - 1)
   Sheets(Split(strSh, ",")).Select
   Unload Me
   Application.Dialogs(xlDialogPrint).Show
   Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Activate()
Dim chk As MSForms.CheckBox
Dim Sh
Dim Oben As Integer

Oben = 8

For Each Sh In ThisWorkbook.Sheets
   Set chk = Me.Controls.Add(bstrprogid:="forms.CheckBox.1", Name:=Sh.Name, Visible:=True)
   With chk
      .Top = Oben          'Abstand zwischen Boxes
      .Left = 30           'Abstand links
      .Caption = Sh.Name   'Tabellenblattname
      .Width = 170         'Breite
   End With
   Oben = Oben + 24
Next
End Sub

Hier werden alle Blätter zur Auswahl in eine Forms gepackt!
Nun möchte ich aber nur die Tabellenblätter ausgewählt bekommen die mit Dia anfangen!
Ich kann hier leider nicht über ThisWorkbook.Charts gehen weil sich hier die Diagramme in einem Blatt befinden :-)
Gibt es hier ne Lösung?

  

Betrifft: AW: Druckmenü von: Snewi
Geschrieben am: 22.02.2012 12:39:22

habs hinbekommen:

Private Sub cmdDrucken_Click()
Dim chk As Control
Dim strSh As String

Application.ScreenUpdating = False
   For Each chk In Me.Controls
      If TypeOf chk Is MSForms.CheckBox Then
         If chk Then 'angehakt?
            strSh = strSh & chk.Caption & ","
         End If
      End If
   Next
   If strSh = "" Then Exit Sub
   strSh = Left(strSh, Len(strSh) - 1)
   Sheets(Split(strSh, ",")).Select
   Unload Me
   Application.Dialogs(xlDialogPrint).Show
   Application.ScreenUpdating = True
   Sheets("Daten").Select
End Sub

Private Sub UserForm_Activate()
Dim chk As MSForms.CheckBox
Dim Sh
Dim Oben As Integer

Oben = 12

For Each Sh In ThisWorkbook.Sheets
   If Left(Sh.Name, 3) = "Dia" Then
      Set chk = Me.Controls.Add(bstrprogid:="forms.CheckBox.1", Name:=Sh.Name, Visible:=True)
      With chk
         .Top = Oben          'Abstand zwischen Boxes
         .Left = 35           'Abstand links
         .Caption = Sh.Name   'Tabellenblattname
         .Width = 170         'Breite
      End With
   End If
   Oben = Oben + 14
Next
End Sub
Das einzige Problem die Diagramme werden nicht so ausgedruckt wie in der Seitenansicht!
Woran könnte das liegen?

Gruß


  

Betrifft: AW: Druckmenü von: fcs
Geschrieben am: 23.02.2012 18:50:49

Hallo Snewi,

was meinst du mit

Das einzige Problem die Diagramme werden nicht so ausgedruckt wie in der Seitenansicht!


Wenn du in einem Tabellenblatt ein eingebettetest Diagramm selektierst und dann die Seitenvorschau anzeigst, dann stellt Excel "nur" das markierte Diagramm dar - ohne die dahinterliegende Tabelle.

Da funktioniert nicht, wenn du mehrere Tabellenblätter selektierst. Dann werden der Inhalt bzw. der Druckbereich des jeweiligen Blatts gedruckt.

Wenn du die Diagramme auf den einzelnen Blättern als Markierung drucken willst, dann müssen die Blätter einzelnen gedruckt und jeweils das Diagramm markiert werden.

Sollte etwa wie folgt aussehen. Evtl. muss du für eine optimale Ausgabe der Diagramme das Seitenformat noch auf quer einstellen.

Gruß
Franz

Private Sub cmdDrucken_Click()
Dim chk As Control
Dim strSh As String, arrSheets, ii As Integer, varauswahl

Application.ScreenUpdating = False
   For Each chk In Me.Controls
      If TypeOf chk Is MSForms.CheckBox Then
         If chk Then 'angehakt?
            strSh = strSh & chk.Caption & ","
         End If
      End If
   Next
   If strSh = "" Then Exit Sub
   strSh = Left(strSh, Len(strSh) - 1)
   arrSheets = Split(strSh, ",")
   Unload Me
   Application.ScreenUpdating = True
   For ii = LBound(arrSheets) To UBound(arrSheets)
    Sheets(arrSheets(ii)).Activate
    ActiveSheet.ChartObjects(1).Activate
    If ii = LBound(arrSheets) Then
      varauswahl = Application.Dialogs(xlDialogPrint).Show
      If varauswahl = False Then Exit Sub
    Else
      ActiveSheet.PrintOut
    End If
   Next
   Sheets("Daten").Select
End Sub