Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1192to1196
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
Inhaltsverzeichnis

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

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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige