Druckbereich abhaengig von Rechtecken

ich bin gerade dabei ein Programm zu entwickeln und stosse hierbei auf ein kleines Problem.
Das Programm soll ein Template fuer die Darstellung von Geschaeftsprozessen sein.
Man erhaelt also die Basis um den Dokumentenfluss inerhalb eines Unternehmens abzubilden.
Zu Beginn sieht man graue Flaechen, die Departments darstellen.
In Spalte A traegt man den Dept. Namen ein, welcher sich in Form von Wasserzeichen jede 7. Spalte wiederholt.
Die zu Beginn erscheinende Box und der dazugehoerige Pfeil sind dargestellt, da sie auf gewisse Werte voreingestellt sind. Sie sollen fuer den weiteren Prozessverlauf kopiert werden.

Mein Problem besteht darin, dass excel bei Druckbefehl grundsaetzlich eine Anzahl von ca. 9 Seiten drucken moechte, da es sich an den Wasserzeichen orientiert, die bis dorthin abgebildet werden.
Nun will ich aber, dass es nicht mehr Seiten als notwendig druckt und sich dementsprechend an den Rechtecken ausrichtet.
Das letzte (also am weitesten rechts abgebildete) Rechteck soll angeben, wieviele Seiten gedruckt werden sollen.

Hier ist das, was ich bis jetzt erstellen konnte, danke schonmal fuer die Hilfe:

Public xDep As Integer
Public i As Integer
Public y As String
Public extradept As Integer
Public k As Integer


Sub setenvironment()

On Error Resume Next


Sheets(2).Select


 y = InputBox("processheadline")

 If y = "" Then

 MsgBox "no headline"

 Exit Sub

 Else

 If IsNumeric(y) Then

 Sheets(2).PageSetup.LeftHeader = "&""verdana,bold""&16" + " " + CStr(y) + ""

 Else

 Sheets(2).PageSetup.LeftHeader = "&""verdana,bold""&16" + CStr(y) + ""

 End If

 End If

 With Sheets(2).PageSetup
 .PrintTitleRows = ""
 .PrintTitleColumns = "$A:blush:A"

 End With

 Sheets(2).PageSetup.PrintArea = ""

 With Sheets(2).PageSetup
 .CenterHeader = ""
 .RightHeader = ""
 .LeftFooter = "&F"
 .CenterFooter = "Page&amp:stuck\_out\_tongue\_winking\_eye:/&N"
 .RightFooter = "Printed on:&D;&T"
 .LeftMargin = Application.InchesToPoints(0.590551181102362)
 .RightMargin = Application.InchesToPoints(0.590551181102362)
 .TopMargin = Application.InchesToPoints(0.78740157480315)
 .BottomMargin = Application.InchesToPoints(0.590551181102362)
 .HeaderMargin = Application.InchesToPoints(0.393700787401575)
 .FooterMargin = Application.InchesToPoints(0.393700787401575)
 .PrintHeadings = False
 .PrintGridlines = False
 .PrintComments = xlPrintNoComments
 .PrintQuality = 600
 .CenterHorizontally = False
 .CenterVertically = False
 .Orientation = xlLandscape
 .Draft = False
 .PaperSize = xlPaperA4
 .FirstPageNumber = xlAutomatic
 .Order = xlDownThenOver
 .BlackAndWhite = False
 .Zoom = 69
 .PrintErrors = xlPrintErrorsDisplayed
 End With

 xDep = InputBox("number of departments?")

 If Not IsNumeric(xDep) Or xDep 


[MOD} - Pre-Tags eingefügt.

Hi Pit,

benutze bitte den pre-Tag, wird unterhalb des Eingabefensters erläutert.
Zuoberst im Modul schreib bitte
Option Explicit
hin. Dann zwingt dich der Debugger zu Dim.
Rücke den Code enstprechend If oder For o.ä. entsprechend um 3-4 Leerzeichen ein.

Um Codeblöcke hin und herzurücken, oben in der Symbolleiste, Rechtsklick, dann Anpassen, irgnedwo da sind die Symbole fürs Blockrücken, die ziehste dir auf Symbolleiste, am besten die zwei Symbole fürs Auskommentieren gleich mit.

Ganz unten habe ich schonmal die unnötigen Leerzeilen entfernt, da ich dafür nur 2 Klicks brauche, aber den Rest zu ordnene ist mir zuviel.

Sub Change_process_headline()

Sheets(2).Select

m = InputBox(„new processheadline“)

If m = „“ Then

MsgBox „no headline“

Exit Sub

Else

If IsNumeric(m) Then

Sheets(2).PageSetup.LeftHeader =
„&“„verdana,bold“"&16" + " " + CStr(m) + „“

Else

Sheets(2).PageSetup.LeftHeader =
„&“„verdana,bold“"&16" + CStr(m) + „“

End If

End If

End Sub

was soll Sheets(2).Select sein? Gibt doch Fehler. Richtig ist Sheets(2).Activate und so ist es am besten:

Sub Change\_process\_headline()
Dim m
With Sheets(2)
 m = InputBox("new processheadline")
 If m = "" Then
 MsgBox "no headline"
 Exit Sub
 Else
 .PageSetup.LeftHeader = "&""verdana,bold""&16" & " " & CStr(m)
 End If
End With
End Sub

Gruß
Reinhard

Option Explicit
'
Public xDep As Integer
Public i As Integer
Public y As String
Public extradept As Integer
Public k As Integer
'
Sub setenvironment()
On Error Resume Next
Sheets(2).Select
 y = InputBox("processheadline")
 If y = "" Then
 MsgBox "no headline"
 Exit Sub
 Else
 If IsNumeric(y) Then
 Sheets(2).PageSetup.LeftHeader = "&""verdana,bold""&16" + " " + CStr(y) + ""
 Else
 Sheets(2).PageSetup.LeftHeader = "&""verdana,bold""&16" + CStr(y) + ""
 End If
 End If
 With Sheets(2).PageSetup
 .PrintTitleRows = ""
 .PrintTitleColumns = "$A:blush:A"
 End With
 Sheets(2).PageSetup.PrintArea = ""
 With Sheets(2).PageSetup
 .CenterHeader = ""
 .RightHeader = ""
 .LeftFooter = "&F"
 .CenterFooter = "Page&amp:stuck\_out\_tongue\_winking\_eye:/&N"
 .RightFooter = "Printed on:&D;&T"
 .LeftMargin = Application.InchesToPoints(0.590551181102362)
 .RightMargin = Application.InchesToPoints(0.590551181102362)
 .TopMargin = Application.InchesToPoints(0.78740157480315)
 .BottomMargin = Application.InchesToPoints(0.590551181102362)
 .HeaderMargin = Application.InchesToPoints(0.393700787401575)
 .FooterMargin = Application.InchesToPoints(0.393700787401575)
 .PrintHeadings = False
 .PrintGridlines = False
 .PrintComments = xlPrintNoComments
 .PrintQuality = 600
 .CenterHorizontally = False
 .CenterVertically = False
 .Orientation = xlLandscape
 .Draft = False
 .PaperSize = xlPaperA4
 .FirstPageNumber = xlAutomatic
 .Order = xlDownThenOver
 .BlackAndWhite = False
 .Zoom = 69
 .PrintErrors = xlPrintErrorsDisplayed
 End With
 xDep = InputBox("number of departments?")
 If Not IsNumeric(xDep) Or xDep 

Nachtrag
Hi Pit,

Public xDep As Integer
bringt dir ggfs. einen Fehler bevor deine
If IsNumeric() greift, da xDep über eine Inputbox gefüllt wird.

Gruß
Reinhard

Hi Reinhard,

danke schonmal fuer deine Antwort.
Das was du geschrieben hast kann ich jedoch nicht so hundert prozentig zuordnen. Ich verstehe nicht so ganz, warum ich nun die Option explicit einfuegen soll. Macht das einen erheblichen Unterschied? Wenn ja, welchen? Mein Programm laeuft doch auch ohne.

Ansonsten kann ich leider nicht erkennen, wie ich nun den Druckbereich einstellen kann. Eher gesagt, wie ich Excel sagen kann, dass sich der zu druckende Bereich danach richten soll, wo das letzte Rechteck zu finden ist und dementsprechend andere Informationen (wie die "Wasserzeichen) ignoriert werden sollen.
Hast du da ne Idee zu?
Dank dir nochmal
Peter

Hallo AUchfalls,

danke schonmal fuer deine Antwort.
Das was du geschrieben hast kann ich jedoch nicht so hundert
prozentig zuordnen. Ich verstehe nicht so ganz, warum ich nun
die Option explicit einfuegen soll. Macht das einen
erheblichen Unterschied? Wenn ja, welchen? Mein Programm
laeuft doch auch ohne.

Mit „Option explicit“ wird VB dazu gezwungen zuerst nachzusehen ob eine Variable deklariert wurde.
kleines Beispiel:

Dim A as Interger

.....
If B = 0 Then .....

Ohne „Option explicit“ läuft dein Program „fehlerfrei“. Beim Erreichen der Zeile „If B = 0 Then …“ legt BASIC einfach eine neue Variable B an, welche zudem mit 0 initialisiert wird …
Nehmen wird an, „B“ war ein Tipfehler …

Mit „Option explicit“ bekommst du eine Fehlermeldung, weil „B“ nicht deklariert wurde …

MfG Peter(TOO)

1 Like