Office: VBA: Bereich variable kopieren, Speichern Unter, Druckvorschau & Drucken

Hallo,

ich brauche wieder eure Hilfe, damit es aber dieses Mal einfacher ist zu verstehen habe ich eine Beispieldatei erstellt. Ich gestehe das es für mich unmöglich scheint, aber ich weiß es gibt mindestens ein Weg. Das Wochenende war lang und ich habe es geschaft das einmal die Datei nicht mehr zu öffnen war, ein anderes Mal das er mir 100 Seiten ausgedruckt hat bis dahin das ich auf einmal so viele Tabellen hatte das mein Rechner sich aufgehängt hat...

Die Mappe hat beim öffnen zwei Tabellen ("Eingabe" und "VORLAGE").
In der Tabelle-Eingabe wird die Tabelle ausgefüllt und kann bis zu 1000 Zeilen haben.
Nachdem man fertig ist mit der Eingabe soll es per Button das Makro starten (Button ist drin).
Als erstes soll er die Tabelle-Vorlage kopieren und eine neue Tabelle erstellen mit dem Namen "Druck".
Daran hab ich das Problem das die Zeilehöhe der Vorlage unterschiedlich ist. Die Vorlage ist so aufgebaut das sie auf eine Seite paßt.
Jetzt will ich das aus der Tabelle-Eingabe so viele Zeilen in die Tabelle Druck eingefügt wird das immer ein Blatt zusammen auf einer Seite steht, sollte es geteilt werden, dann soll es auf der nächste Seite komplett eingefügt werden. Sprich die Vorlage soll jedes Mal erneut darunter kopiert werden wenn die vorherige Kopie nicht mehr vom Platz ausreicht. Siehe Bsp.-Datei mit Blatt 1/1 usw.
da wo '- - - zu sehen ist war das Blatt zu lang um zusammen da einzufügen und sollt auf einer neuen Seite der Vorlage fortgesetzt werden.

Ich habe in der Beispieldatei gleich die Tabelle Druck manuell erstellt, so das man sehen kann was ich erreichen will.

Desweiteren will ich das eine Zelle unter dem Blatt die Seitenzahl/Gesamtseitenzahl steht. ( 1 / 3; 2 / 3; 3 / 3 bei diesem Beispiel, bei mehr oder weniger Seiten, dementsprechend automatisch anpassen).

Das summieren der Spalte je Blatt und die Gesamtsumme.

Wenn alles übertragen wurde soll es als erstes das Dialog Speichern unter aufrufen und als Dateiname schon den Zellinhalt I3 & Datum(JJJJ;MM;DD) vorschlagen. Es soll verhindert werden das die Originaldatei überschrieben wird, bei 'Abbrechen' zurück zur Mappe ohne Funktion. Ach ja, Speichern in ein Unterordner weiter "...\Save\"

Erst nach dem Speichern erlauben das Fenster zum Drucken zu öffnen Seitenansicht soll möglich sein, Anzahl der Exemplare auf 3 Stück stellen. Ideal wäre es wenn ich auch noch einen Drucker per Makro auswählen kann (Netzwerkdrucker mit fester IP-Adresse).

Nach dem Druckauftrag sollte die Datei geschlossen werden.

Entschuldigt das ich nur Stichwortartig schreibe, möchte nicht ein Roman eröffnen, aber möchte auch nicht etwas vergessen was ich mir da vorstelle. Ich weiß das ist eine ganze Menge, aber es ist einfacher wenn man alle Fakten kennt als das ich immer nach und nach einzelne Fakte nenne.

Hoffe mir kann man hierbei helfen. ( Also mit der Mappe)

Viele Grüße
Emi

 

Hallo Emi, ich würde so vorgehen:

'CurrentRegion ermittelt zuverlässig den benutzten Bereich(Es darf aber keine unbeschriebenen Zeilen in der Liste geben.)
Dim R As Range 'DatenBereich ohne Überschrift
Set R = Range("e5").CurrentRegion
Set R = Range("e5").Offset(1).Resize(R.Rows.Count - 1)
'MsgBox r.Address(0, 0)



Dim Rsplit 'Union der Teilbereiche
Set Rsplit = R.Columns(1).ColumnDifferences(Range("e6"))
'MsgBox Rsplit.Address(0, 0)


Dim Rarea As Range 'ein Teilbereich
Dim Rtemp As Range 'ein Teilbereich mit Kopf
Dim Rcopy As Range 'zusammengesetzter Bereich<26Zeilen
For Each Rarea In Rsplit.Areas

Set Rtemp = Rarea.Offset(-1).Resize(Rarea.Count + 1, 9)
If Not Rcopy Is Nothing Then
Set Rtemp = Union(Rcopy, Rtemp)
' MsgBox Rtemp.Address(0, 0)
If Rtemp.Rows.Count > 25 Then

'kopiere Vorlage to Druck
'kopiere Rcopy.Value to Druck
Set Rcopy = Nothing
Set Rtemp =Rarea.Offset(-1).Resize(Rarea.Count + 1, 9)​

End If
End If
Set Rcopy =Rtemp​

Next


'Rest, wenn vorhanden
If Not Rcopy Is Nothing Then
'kopiere Vorlage to Druck
'kopiere Rcopy.Value to Druck
End If


bei Druck... , Netzwerk... kann ich nicht helfen; habe ich alles nicht zur Verfügung

 

Hallo,

endlich wieder Gesund und bereit die Welt wieder auf den Kopf zu stellen. Seit Montag stehe ich davor und Rudi's Vorschlag funktioniert einwandfrei, also wenn man von den Werten die per MsgBox kommt urteilt, nur musste der Wert 25 auf 24 geändert werden, da er sonst zuviel auswählt.

Ein herzliches Dankeschön an Rudi, habe etwas gebraucht um den durchblick zu bekommen, aber was ich bisher gesehen habe funktioniert es bestimmt, nur muss ich noch herrausfinden wie ich mich da anlogge.

Die Vorlage to Druck kopieren habe ich bisher so gelößt:

Code:

Sheets("Vorlage").Rows("1:42").Copy
Sheets("Druck").Range("A1").PasteSpecial
Application.CutCopyMode = False

Am Anfang locker angefangen und bis jetzt mich rumgärgert bis ich herausgefunden habe wie man die Zellenhöhe mitkopiert. Leider kopiert er jetzt das Bild nicht mit das über die Zellen A1:C5 sitzt. Etwas zweifle ich das dies ausreicht, denn jetzt bin ich am Überlegen wie ich die Tabelle nochmal drunter kopieren kann, also passt er doch nicht....

Ich sage Morgen geht es weiter... ;)

Edit:
Ach ja zum Drucker, dank Makrorecorder sehe ich wie die einzelne Auswahl treffen kann, also 'Dürfte' dies kein größes Problem sein.

Ich muss nochmal das ganze durchspielen, denke das ich daran doch etwas ändern werde da ich es einfach nicht hinbekomme. Anstatt die Tabelle "Vorlage" immer nach bedarf in die Tabelle "Druck" einzufügen werde ich es wohl so drehen müssen das am Ende die Seiten rauslösche die zuviel sind.... Ich brauch jetzt erst einmal etwas süßes um klaren Kopf zu bekommen. Heute wollt einfach garnichts klappen.

 

Hallo, :D

keine Änderung geplant, alles soll so bleiben....

bin etwas weiter gekommen, das Problem mit dem Bild habe ich so gelößt das es immer neu eingefügt wird beim Kopieren und bin verwundert das es perfekt paßt. Danke an Jinx, hab es aus einem älteren Beitrag im Forum rausgesucht, ergänzt und angepaßt.

Eines des Problems ist das bei kopieren aus der Tabelle "Eingabe" in die Tabelle "Druck" ist, dass er nicht die Werte nimmt sondern die Formeln die da drin stehen kopiert. Da er logischerweise die einzelne Werte nicht mitkopiert zeigt er '#BEZUG!' an.
Wie kopiere ich den Wert und nicht die Formel? Irgendwie bekomme ich .Value nicht unter.

Des weiteren kopiert er für die zweite Seite im Druck den letzten Abschnitt von der ersten Seite mit, das bekomme ich auch nicht unter Kontrolle.

Code:

Dim oPic as Picture
Dim xKopieren as Stringe

xKopieren = 1

'...
'In der Schleife nach der Bedingung >25 geht's weiter...

Sheets("Vorlage").Rows("1:42").Copy
Sheets("Druck").Cells(xKopieren, 1).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=False
'Leere Tabelle von VORLAGE in das Blatt DRUCK kopieren

Set oPic = Sheets("Druck").Pictures.Insert(D:\ORDNER\FILENAME.jpg")
With Sheets("Druck").Cells(xKopieren, 1)
   oPic.Left = .Left + 15
   oPic.Top = .Top + 12.5
   oPic.Height = 75
   oPic.Width = 100
End With
Set oPic = Nothing
'Bild passend einfügen

Union(Rcopy, Rtemp).Copy
Sheets("Druck").Cells(xKopieren + 7, 1).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=False
'Aus Tab Eingabe kopieren und in Tab Druck einfügen

xKopieren = xKopieren + 42
'+42 da bei der nächsten Runde die erste Freie Zeile nach 42 Zeilen kommt, fixer Wert.

Soweit bin ich bisher. Für Ideen für Verbesserung oder passende Zusätze damit's besser und Fehlerfrei läuft bin ich wie immer sehr dankbar.

Gruß und bis bald
Emi

---Edit:
So, es werden jetzt Werte kopiert anstatt die Formel, ich hatte es die ganze Zeit in der Hand und sah es nicht. Anstatt "Paste:=xlPasteAll" gehört da "Paste:=xlPasteValues"
Ja, ich weiß...

Keinen Anhaltspunkt gefunden warum er mir von der ersten Seite den letzten Abschnitt auf die zweite Seite erneut einfügt.

Bin jetzt an den Seitenzahlen dran.

 

Hallo Emi

Ich schon
Du solltest Rcopy kopieren, nicht Union(Rcopy, Rtemp)!

Dim xKopieren as Stringe ist absoluter Blödsinn!
(ich verwend klare Worte um dir klar zu machen: Programmieren ist kein Spiel sondern konzentrierte Arbeit. Ein falsches Zeichen und nichts funktioniert mehr.)
Richtig wäre: Dim xKopieren as Long

Verwende Option Expicit

siehe PN

 

Hallo,
Hallo Rudi,

ich sitze des öfteres davor und wundere mich warum es jetzt nicht mehr geht. In der Regel finde ich das falsche Zeichen, verliere nicht die Geduld um mir das ganze immer wieder durchzulesen.

Ich gebe mir Mühe das alles zu verstehen, ich habe bisher noch nie mit programmieren zu tun gehabt. Ich sitze hier mit einigen Büchern und durchwühle das Internet um alles zu verstehen und versuche meine Vorstellung zu erfüllen. Das ist auch der Grund weshalb ich immer so dankbar bin wenn mir geholfen wird. Wer will nicht einen Weg finden um seine Arbeit zu erleichtern?

Danke für die PN.

Muss gestehen das Rcopy kopieren erst nicht wollte und deshalb mit Union(Rcpoy, Rtemp) versucht habe und es teilweise funktionierte. Immerhin funktionert es jetzt einwandfrei, weshalb es früher nicht wollte... gute Frage.

Ich habe jetzt die Seitenzahl v. Gesamt Seitenzahl einwandfrei erstellt, Jetzt versuche ich das es mir die Summe korrekt bildet.

Gruß
Emi

 

Hallo Emi,

vor ca 15 Jahren habe ich meine ersten Makros geschrieben. Das funktionierte zwar, aber nur so lala. Heute lache ich darüber.
Ich hatte damals nicht die Möglichkeit, über ein Forum zu fragen.

Als ich deine Frage gelesen hatte fielen mir sofort 10 verschiedene Lösungen ein, und du wirst auch von 10 Leuten 10 verschiedene Lösungswege bekommen. Es gibt eben keinen Königsweg. Du hast heute den unschätzbaren Vorteil, ein Forum zu nutzen. Wenn hier niemand eine Lösung anbietet, dann eben in einem anderen Forum. Aber bitte keinen Rundumschlag (Crossposting).

Deine Problemstellung zielt darauf ab, Daten für den Druck aufzubereiten. Ich habe keinen Drucker, kann dir also kein getestetes Makro zur Vergfügung stellen, selbst wenn ich deine Originaldateien hätte.

Ein Tabellenblatt hat 2^20 Zeilen. Du kannst also über eine Million Datensätze in einer Tabelle verarbeiten. Das sollte reichen. Über die Anwendung einer Datenbank würde ich erst bei mehreren 100 000 Datensätzen nachdenken. Außerdem bedarf es eines Spezialisten für die Betreuung, von dem ich dann abhängig wäre, oder gewisser finanzieller Mittel für ein fertiges Programm. Soweit ich das einschätzen kann, ist Excel für dein Vorhaben genau das richtige Programm.

Viel Erfolg