Druckbereich - Druckversion +- Office-Fragen.de (https://office-fragen.de) +-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html) +--- Forum: Excel (https://office-fragen.de/forum-2.html) +--- Thema: Druckbereich (/thread-27968.html) |
Druckbereich - Max11 - 19.04.2022 Morgen Zusammen, Ich habe eine Excel Datei mit 2 Tabellen, die sich des Öfteren mit neuen Inhalten ausgefüllt werden. Aktuelle Läuft Folgende Makro : Es kommt ein msgbox wo du den Standardwert "10" eingibst. Daraufhin werden die Inhalte der Tabelle in 10er Schritten pro Blatt ausgedruckt. Beispiel: Es gibt 35 Zeilen in der Tabelle 1-10 Zeile = 1 Blatt 11-21 Zeile = 2 Blatt 22-32 Zeile = 3 Blatt 33-35 Zeile = 4 Blatt Gibt es die Möglichkeit das man beim msgbox selber individuell bestimmen kann wie viel Inhalte ein Blatt haben soll, Zum Beispiel das 1. Blatt bis 13 Zeilen ausgedruckt werden soll. Blatt 2 bis 20 Zeilen ich hoffe das man mein Wunsch verstanden hat. Wenn ist hilfreich ist, könnte ich auch das Makro bzw. den Code für den Jeweiligen zu schicken Würde mich für jede Hilfe freuen LG RE: Druckbereich - steve1da - 19.04.2022 Hola, Zitat:Wenn ist hilfreich ist, könnte ich auch das Makro bzw. den Code für den Jeweiligen zu schickendu kannst es auch einfach hier hin schreiben. Gruß, steve1da RE: Druckbereich - Max11 - 19.04.2022 Hier der folgende Code. Vielleicht kann man das ja so ändern das nicht Standard wert 46 ist pro Tour sondern beliebig die Toren festlegt. lg Dim Menge Dim LfdMin Dim LfdMax Dim Tour Dim TourI Dim KLT Sheets("LSA").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 KLTs (Wert in letzter Zeile Lfd-Nr) KLT = Range("A" & Ende).Value ' Summe der KLTs pro Tour Range("H1").Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[9999]C)" With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With Menge = InputBox("Bitte Anzahl KLT pro Tour eingeben" & vbCrLf & "Zum Drucken OK wählen", "Drucken", 46) If Menge = "" Then GoTo EndPrint Else ' WA 1.2 Calculate number of tours with 5 more than total add hard exit of tour loop. ' Because it might be wrong, if each of the first tours have less than defined KLTs Tour = Application.RoundUp((KLT + 10) / Menge, 0) 'Tour = 100 LfdMin = 0 For TourI = 1 To Tour Sheets("LSA").Select LfdMax = Menge + LfdMin ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=1, Criteria1:="<=" & LfdMax, _ Operator:=xlAnd, Criteria2:=">" & LfdMin ' maximal 46 KLTs ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=3, Criteria1:="<=" & LfdMax, _ Operator:=xlOr, Criteria2:="=" LfdMax = Cells(1, 8) + LfdMin ' Hilfsspalte für Schattierung der ersten Spalte je Tour 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 = TourI If LfdMax - LfdMin <> 1 Then Selection.FillDown End If Columns("Q:Q").Select Selection.EntireColumn.Hidden = True ' ---------------------- Range("F1").Select ActiveCell.FormulaR1C1 = "Delivery-List - Tour " & TourI Selection.Font.Bold = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False 'LfdMin = LfdMin + Menge Sheets("MA").Select ActiveSheet.Range("A2:S" & Ende).AutoFilter Field:=1, Criteria1:="<=" & LfdMax, _ Operator:=xlAnd, Criteria2:=">" & LfdMin Range("F1").Select ActiveCell.FormulaR1C1 = "Pick-List - Tour " & TourI Selection.Font.Bold = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False ' WA 1.2 Exit of loon, if number of tours has been calculated to high If LfdMax = KLT Then GoTo EndPrint End If LfdMin = LfdMax Next TourI End If EndPrint: Sheets("MA").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("LSA").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 ' Cond. formatting to show selected routes in total pick-list 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: End Sub RE: Druckbereich - steve1da - 19.04.2022 https://office-fragen.de/thread-13.html Bitte nachholen. RE: Druckbereich - Max11 - 19.04.2022 In welche Forum soll ich den Beitrag verlinken ? Hab es leider nicht verstanden, tut mir leid LG RE: Druckbereich - steve1da - 19.04.2022 In jedem Forum wo die Frage steht kommt ein Link zum dem/den anderen Forum/Foren. RE: Druckbereich - Max11 - 19.04.2022 In den Forum wo ich gefragt habe konnte mir leider keiner helfen .. Aber danke für den Hinweis LG RE: Druckbereich - steve1da - 19.04.2022 Darum geht es nicht. Google nach Crossposting, vielleicht wird es dann klarer. Edit: ok, scheinbar nicht.... https://www.herber.de/forum/archiv/1876to1880/1879980_Druckbereiche_Definieren.html RE: Druckbereich - Max11 - 19.04.2022 danke für die Mühe Steve. Könntest du mir vielleicht bei meinem anliegen weiter helfen ? tut mir leid, aber ich bin echt verzweifelt ... LG |