Anzeige
Archiv - Navigation
1124to1128
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

before print | Herbers Excel-Forum

before print
06.01.2010 17:52:13
Ralf

Hallo
kann man ein makro so erstellen ?
das es vor dem Drucken alle Zellen in G leert wenn nicht in F SW steht und nach dem Drucken soll es wieder rückgängig gemacht werden
Und das in dem zeilen 16 - 120
und wenn das geht dann noch am besten über eine Schaltfläche :-)
gruß

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: before print
06.01.2010 18:16:51
Hajo_Zi
Hallo Ralf,
versuche es mal mit folgendem Makro, ungetestet.
Option Explicit
Sub Makro1()
Range("G6:G120").NumberFormat = ";;;"
ActiveSheet.PrintOut
Range("G6:G120").NumberFormat = "General"
End Sub

AW: before print
06.01.2010 18:19:06
Tino
Hallo,
könnte z. Bsp. so funktionieren.
Tabelle im Code noch anpassen.
kommt als Code in DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
Dim A& 
Dim meArG(), meArFG() 
 
With Sheets("Tabelle1") 'Tabelle anpassen 
    MerkAr = .Range("G16:G120").Value2 
    meArFG = .Range("G16:F120").Value2 
     
    meArG = MerkAr 
     
    For A = 1 To Ubound(meArFG) 
        If meArFG(A, 1) <> "SW" Then 
            meArG(A, 1) = "" 
        End If 
    Next A 
 
    .Range("G16").Resize(Ubound(meArG)) = meArG 
End With 
 
Application.OnTime Now + TimeSerial(0, 0, 1), "NachPrint" 
 
End Sub 
 
kommt als Code in Modul1
Option Explicit 
Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias _
                    "GetMem4" (pArray() As Any, sfaPtr As Long) 
Public MerkAr() 
 
Sub NachPrint() 
Dim sfaPtr As Long 
GetSafeArrayPointer MerkAr, sfaPtr 
If sfaPtr > 0 Then 
    'Tabelle anpassen 
    Sheets("Tabelle1").Range("G16").Resize(Ubound(MerkAr)) = MerkAr 
    Erase MerkAr 
End If 
End Sub 
Gruß Tino
Anzeige
AW: before print
06.01.2010 18:30:04
Ralf
donner gehst Du ab :-)
Danke das hat mir sehr geholfen jetzt noch nje frage ich habe mehrere tabellenblätter wo ich das brauche
kann man den bereich Tabelle anpassen so gestalten das das makro auf mehrere tabellen in der Arbeitzmappe funktioniert ?
also ich habe tabellenblätter jan feb mär apr ...... bis dez
kannst ja mal testen,
06.01.2010 19:29:44
Tino
Hallo,
die Tabellen
Jan, Feb, Mrz, Apr, Mai, Jun, Jul,Aug ,Sep ,Okt ,Nov u. Dez
müssen vorhanden sein es gibt keine Fehlerüberprüfung.
kommt als Code in DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
Dim A& 
Dim meArG(), meArFG() 
Dim i As Integer, sMonat$ 
 
For i = 1 To 12 
  
    With Sheets(MonthName(i, True)) 'Tabelle Jan bis Dez 
 
        MerkAr(i) = .Range("G16:G120").Value2 
        meArFG = .Range("G16:F120").Value2 
         
        meArG = MerkAr(i) 
         
        For A = 1 To Ubound(meArFG) 
            If meArFG(A, 1) <> "SW" Then 
                meArG(A, 1) = "" 
            End If 
        Next A 
     
        .Range("G16").Resize(Ubound(meArG)) = meArG 
    End With 
Next i 
Application.OnTime Now + TimeSerial(0, 0, 1), "NachPrint" 
 
End Sub 
 
kommt als Code in Modul1
Option Explicit 
Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias _
                    "GetMem4" (pArray() As Any, sfaPtr As Long) 
Public MerkAr(1 To 12) 
 
Sub NachPrint() 
Dim sfaPtr As Long 
Dim i As Integer 
 
GetSafeArrayPointer MerkAr, sfaPtr 
 
If sfaPtr > 0 Then 
  For i = 1 To 12 
    With Sheets(MonthName(i, True)) 'Tabelle Jan bis Dez 
    .Range("G16").Resize(Ubound(MerkAr(i))) = MerkAr(i) 
    End With 
  Next i 
  Erase MerkAr 
End If 
End Sub 
Gruß Tino
Anzeige
Korrektur wegen Tabellennamen
06.01.2010 19:45:45
Tino
Hallo,
weil Deine Monate nicht wie von mir angegeben benannt sind
hier die Version wo Du die Tabellennamen angeben kannst.
kommt als Code in DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
Dim A& 
Dim meArG(), meArFG() 
Dim i As Integer, sMonat$ 
Dim meArTabellen 
 
'Tabellennamen eintragen 
meArTabellen = Array("jan", "feb", "mär", "apr", "mai", "jun", "jul", "aug", "sep", "okt", "nov", "dez") 
Redim Preserve MerkAr(0 To 11) 
For i = Lbound(meArTabellen) To Ubound(meArTabellen) 
  
    With Sheets(meArTabellen(i)) 'Tabelle Jan bis Dez 
 
        MerkAr(i) = .Range("G16:G120").Value2 
        meArFG = .Range("G16:F120").Value2 
         
        meArG = MerkAr(i) 
         
        For A = 1 To Ubound(meArFG) 
            If meArFG(A, 1) <> "SW" Then 
                meArG(A, 1) = "" 
            End If 
        Next A 
     
        .Range("G16").Resize(Ubound(meArG)) = meArG 
    End With 
Next i 
Application.OnTime Now + TimeSerial(0, 0, 1), "NachPrint" 
 
End Sub 
 
kommt als Code in Modul1
Option Explicit 
Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias _
                    "GetMem4" (pArray() As Any, sfaPtr As Long) 
 
Public MerkAr() 
 
Sub NachPrint() 
Dim sfaPtr As Long 
Dim i As Integer 
Dim meArTabellen 
 
GetSafeArrayPointer MerkAr, sfaPtr 
 
If sfaPtr > 0 Then 
    'Tabellennamen eintragen 
    meArTabellen = Array("jan", "feb", "mär", "apr", "mai", "jun", "jul", "aug", "sep", "okt", "nov", "dez") 
    For i = Lbound(meArTabellen) To Ubound(meArTabellen) 
      With Sheets(meArTabellen(i)) 'Tabelle Jan bis Dez 
      .Range("G16").Resize(Ubound(MerkAr(i))) = MerkAr(i) 
      End With 
    Next i 
    Erase MerkAr 
End If 
 
End Sub 
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige