Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Druckmakro ändern bzw. ergänzen

Forumthread: Druckmakro ändern bzw. ergänzen

Druckmakro ändern bzw. ergänzen
Josef_T
Guten Morgen zusammen und Frohes Neues Jahr.
Habe ein Druckmakro, dass ich gerne so ergänzen möchte: Druckersymbol anklicken, es öffnet
sich eine Box, in der ich die Anzahl der Ausdrucke bestimmen kann.
Hier das Makro: https://www.herber.de/bbs/user/72973.xls
Kann mir bitte jemand helfen, dass Makro umzuschreiben?
Meine VB-Kentnisse sind ganz schlecht.
Danke schon mal
Gruß
Josef
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Druckmakro ändern bzw. ergänzen
08.01.2011 08:41:17
Josef

Hallo Josef,
probier mal.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim rng As Range, intCopies As Integer
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  
  If ActiveSheet.Name = "Tabelle1" Then
    Cancel = True
    intCopies = Application.InputBox("Anzahl der AUsdrucke:", "Drucken", 1, Type:=1)
    If intCopies > 0 Then
      For Each rng In Range("E5:E25").Cells
        If rng.Value <= 0 Then rng.EntireRow.Hidden = True
      Next rng
      ActiveSheet.Prinout copies:=intCopies
      ActiveSheet.Rows.Hidden = False
    End If
  End If
  
  If ActiveSheet.Name = "Tabelle2" Then
    Cancel = True
    intCopies = Application.InputBox("Anzahl der AUsdrucke:", "Drucken", 1, Type:=1)
    If intCopies > 0 Then
      For Each rng In Range("D5:D25").Cells
        If rng.Value <= 0 Then rng.EntireRow.Hidden = True
      Next rng
      Columns("B:B").EntireColumn.Hidden = True
      
      ActiveSheet.Prinout copies:=intCopies
      
      ActiveSheet.Rows.Hidden = False
      Columns("B:B").EntireColumn.Hidden = False
    End If
  End If
  
  ErrExit:
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  
End Sub


Gruß Sepp

Anzeige
AW: Funktioniert Super.-Sepp!
08.01.2011 11:42:42
Josef_T
Guten Morgen Sepp,
Das von Dir geschriebene Makro, funktioniert natürlich wie immer, einwandfrei.
Danke sehr und noch ein schönes Wochenende.
Gruß Josef
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige