Thema Datum  Von Nutzer Rating
Antwort
Rot Verzweifelt (Drucken)
07.04.2022 09:34:51 Gast45202
NotSolved

Ansicht des Beitrags:
Von:
Gast45202
Datum:
07.04.2022 09:34:51
Views:
62
Rating: Antwort:
  Ja
Thema:
Verzweifelt (Drucken)

Morgen Zusammen,
Vorerst möchste ich sagen, dass ich nicht soviel erfahrung habe mit VBA und glaube das mein Problem/Wunsch leicht zu lösen ist.
Das Makro steht schon und ich glaube man muss nur wenig was ändern .

Das ist aktuell die Formel. wenn ich die Zahl 40 eingebe, wird es immer in 40er schritten ausgedruckt(Weil die Excel Datei mehr als 40 Zahlen hat)
Bsp: 100 Zahlen.
Eingabe: 40
Ergebnis= 1 Blatt 40 Zahlen
2 Blatt 40 Zahlen
3 Blatt 20 Zahlen

Ich würde gerne aber das es so ausgedruckt wird : 1 Blatt 80 Zahlen
2 Blatt 10 Zahlen
3 Blatt 10 Zahlen

Dazu muss ich sagen, dass es manchmal auch mehr Zahlen in der Excel Datei stehen bsp:250 aber es soll trotzdem zuerst 80,10, 10 pro Blatt und der Rest auf den Nächten Blatt ausgedruckt werden.

Also ich würde gerne, selber jedes mal im InputBox entscheiden in welchen Schriten es ausgedruckt werden soll
Ich hoffe man konnte es etwas verstehen.

 

Formel : 

 Dim Menge

   Dim XXAMin

   Dim XXBMax

   Dim Runde

   Dim RundeI

   Dim zahl

 

   Sheets("Blatt1").Select

   

' setzt Filter um ihn nachher löschen zu können

   ActiveSheet.Range("A2:A1000").AutoFilter Field:=1, Criteria1:="<=" & 1000

' Löscht Filter

   ActiveSheet.ShowAllData

   

' Ermittlung der letzten Zeile

    Dim Ende As Long

 

    With ActiveSheet

        Ende = .Cells(.Rows.Count, 2).End(xlUp).Row

    End With

 

' Löscht bedingte Formatierung in Spalte A

 

   Range("A3:C" & Ende).Select

   Selection.FormatConditions.Delete

         

' Ermittelt Anzahl der Zahlen

    KLT = Range("A" & Ende).Value

   

' Summe der Zahlen pro Runde

    Range("H1").Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[8]C:R[9999]C)"

    With Selection.Font

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = 0

    End With

 

   

   Menge = InputBox("Bitte Zahl eingeben" & vbCrLf & "Zum Drucken OK wählen", "Drucken", 40)

       

   If Menge = "" Then

   GoTo EndPrint

   Else

   '

   

     Runde = Application.RoundUp((zahl + 10) / Menge, 0)

     'Runde = 100

     

     XXAMin = 0

     For RundeI = 1 To Runde

         

          Sheets("Blatt1").Select

 

          XXBMax = Menge + XXAMin

          ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=1, Criteria1:="<=" & XXBMax, _

          Operator:=xlAnd, Criteria2:=">" & XXAMin

         

         

          ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=3, Criteria1:="<=" & XXBMax, _

          Operator:=xlOr, Criteria2:="="

         

          XXBMax = Cells(1, 8) + XXAMin

         

         

          ' Hilfsspalte für Schattierung der ersten Spalte je Runde

          Columns("Q:Q").Select

          Selection.EntireColumn.Hidden = False

                   

          Range("Q3:Q" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells(1).Select

           

          Range("Q3:Q" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Select

         

          ActiveCell.FormulaR1C1 = RundeI

          If XXBMax - XXAMin <> 1 Then

             Selection.FillDown

            End If

         

          Columns("Q:Q").Select

          Selection.EntireColumn.Hidden = True

 

          ' ----------------------

         

          Range("F1").Select

          ActiveCell.FormulaR1C1 = "batt2 - Runde " & RundeI

          Selection.Font.Bold = True

         

          ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _

              IgnorePrintAreas:=False

       

         

          Sheets("Blatto").Select

          ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=1, Criteria1:="<=" & XXBMax, _

          Operator:=xlAnd, Criteria2:=">" & XXAMin

         

          Range("F1").Select

          ActiveCell.FormulaR1C1 = "batt3 - Runde " & RundeI

          Selection.Font.Bold = True

         

          ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _

              IgnorePrintAreas:=False

         

 

          If XXBMax = zahl Then

           GoTo EndPrint

          End If

                   

          XXAMin = XXBMax

                 

     Next RundeI

   

   End If

   

EndPrint:

 

    Sheets("Blatto").Select

'   setzt Filter um ihne nachher löschen zu können

    ActiveSheet.Range("A2:A1000").AutoFilter Field:=1, Criteria1:="<=" & 1000

'   Löscht Filter

    ActiveSheet.ShowAllData

     

    Sheets("Blatt1").Select

'   setzt Filter um ihne nachher löschen zu können

    ActiveSheet.Range("A2:A1000").AutoFilter Field:=1, Criteria1:="<=" & 1000

'   Löscht Filter

    ActiveSheet.ShowAllData

   

   

'

   If Menge = "" Then

    GoTo EndSub

   Else

    Range("A3:A" & Ende).Select

    Range("A3").Activate

    'Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISTGERADE(AUFRUNDEN(A3 /" & Menge & "; 0))"

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISTGERADE(Q3)"

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1).Interior

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = -0.14996795556505

    End With

   End If

 

EndSub:


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Verzweifelt (Drucken)
07.04.2022 09:34:51 Gast45202
NotSolved