Suche Lösung in VBA

[ToXiC]

Hallo,

ich habe mich bisher nicht viel mit VBA beschäftigen müssen. Jetzt habe ich irgendwie was zusammengebastelt. Das ist zwar sicher nicht die optimale Lösung, aber funktioniert.

Sagen wir so, es funktioniert, solange ich nicht Zeilen einfüge oder sich die Zeilenhöhe ändert.
Der Punkt ist, dass ich im Code Bereiche festgelegt habe, die sich aber verändern, also muss es irgendwie variabel sein.
Es wurde für einige Bereiche die Formatierung festgelegt. Außerdem ist im Code enthalten, dass sich die Zeilenhöhe automatisch anpasst, wenn der Text nicht passt, gerade für verbundene Zellen.

Da sich die Bereiche verändern, also weitere Zeilen hinzu kommen, sollen die Bereiche in VBA nun automatisch erweitert werden, damit die Formatierung beibehalten wird und nicht in konflikt mit anderen Bereichen kommt und das Format dann überschreibt.

Anbei die Tabelle und der Code. Bitte stellt Fragen, damit ich dann genauer darauf eingehen kann, gerne nehme ich auch Tipps zur generellen Verbesserung des Codes entgegen.

Deckblatt

	B	C	D	E	F	G	H	I	J	K	L	M
1	Arbeitspaket
2
3	Projektname / Nr.:					Teilprojekt:
4	Arbeitspaket-Nr. oder PSP-Code:					AP-Verantwortlich:
5	AP-Name:
6
7	Plandatum Start Soll:					Plandatum Ende Soll:
8	Plandatum Start Ist:					Plandatum Ende Ist:
9	Dauer:					Bericht an:
10	Ressourcen:		0,0
11	Budget:
12	Personalkosten:
13	Invest:		0 €
14	Ext. Kosten:		0 €
15
16	Chancen:
17	Risiken:
18	Vorgänger:
19	Nachfolger:
20
21	Arbeitsschritte/ Aktivitäten
22
23	Lfd-Nr.	Arbeitsschritte/ Aktivitäten		Verantwortlich			Mitwirkende	Aufwand in Projekttagen		Ext. Kosten		Invest
24	1
25	2
26	3
27	4
28	5
29	6
30	7
31	8
32	9
33	10
34	Summe:							0,0		0 €		0 €
35
36	Arbeitspaket abgeschlossen: _____________________________________                       ________________________________________ Datum/ Unterschrift AP-Verantwortliche/r                               Datum/ Unterschrift Projektleiter/in

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
         If Target.Count > 1 Then Exit Sub
            ' Blattschutz aufheben
       ActiveSheet.Unprotect Password:="tente"
       
       With Target.MergeArea
            ' Zellverbund aufheben
       .UnMerge
            ' Ausrichtung über alle Zellen
       .HorizontalAlignment = xlCenterAcrossSelection
            '  automatische Zeilenhöhe
       .EntireRow.AutoFit
            ' Zellen verbinden
       .Merge
       End With
       
            ' Bereiche setzen und formatieren
       Dim bereich1 As Range
       Dim bereich2 As Range
       Dim gesamtbereich1 As Range
       Set bereich1 = Range("B23:B47")
       Set bereich2 = Range("C23:M23")
       Set gesamtbereich1 = Union(bereich1, bereich2)
       gesamtbereich1.HorizontalAlignment = xlCenter
       gesamtbereich1.VerticalAlignment = xlCenter
       Dim bereich3 As Range
       Dim bereich4 As Range
       Dim bereich5 As Range
       Dim gesamtbereich2 As Range
       Set bereich3 = Range("B36:M36")
       Set bereich4 = Range("B3:M19")
       Set bereich5 = Range("C24:M34")
       Set gesamtbereich2 = Union(bereich3, bereich4, bereich5)
       gesamtbereich2.HorizontalAlignment = xlLeft
       gesamtbereich2.VerticalAlignment = xlCenter
       
       With ActiveSheet
            ' Blattschutz setzen, Rechte vergeben
            ' https://msdn.microsoft.com/de-de/library/office/ff840611.aspx
       .EnableSelection = xlUnlockedCells
       .Protect Password:="tente", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True
       End With
       
End Sub

[Rabe]

Hi,

Der Punkt ist, dass ich im Code Bereiche festgelegt habe, die sich aber verändern, also muss es irgendwie variabel sein.
Es wurde für einige Bereiche die Formatierung festgelegt. Außerdem ist im Code enthalten, dass sich die Zeilenhöhe automatisch anpasst, wenn der Text nicht passt, gerade für verbundene Zellen.

Da sich die Bereiche verändern, also weitere Zeilen hinzu kommen, sollen die Bereiche in VBA nun automatisch erweitert werden, damit die Formatierung beibehalten wird und nicht in konflikt mit anderen Bereichen kommt und das Format dann überschreibt.

ich gehe davon aus, daß im Kopfbereich (Zeile 1-23) keine Zeilen hinzukommen, sondern nur im Bereich Zeile 24 - 33, also ist auch nur dies der Bereich, der im Makro variabel sein muß.
Du könntest dazu in Spalte B mittels VBA WorksheetFunction.Find() feststellen lassen, in welcher Zeile das "Summe:" steht und dann von Zeile 24 bis Zeile(Summe)-1 Dein Makro anwenden.

so hätte ich es gemacht, leider funktioniert WorksheetFunction noch nicht (die MsgBox-Zeilen sind nur zum ausprobieren):

   Dim bereich1 As Range
   Dim bereich2 As Range
   Dim gesamtbereich1 As Range
   Dim bereich3 As Range
   Dim bereich4 As Range
   Dim bereich5 As Range
   Dim gesamtbereich2 As Range
   Dim doZeile As Double
   
   doZeile = 1000
   MsgBox doZeile
   doZeile = WorksheetFunction.Find("Tabelle1", Range("B24:B" & doZeile), "Summe:")
   MsgBox doZeile
   
   Set bereich1 = Range("B23:B" & doZeile)
   Set bereich2 = Range("C23:M23")
   Set gesamtbereich1 = Union(bereich1, bereich2)
   gesamtbereich1.HorizontalAlignment = xlCenter
   gesamtbereich1.VerticalAlignment = xlCenter
   
   Set bereich3 = Range("B" & doZeile + 2 & ":M" & doZeile + 2)
   Set bereich4 = Range("B3:M19")
   Set bereich5 = Range("C24:M" & doZeile)
   Set gesamtbereich2 = Union(bereich3, bereich4, bereich5)
   gesamtbereich2.HorizontalAlignment = xlLeft
   gesamtbereich2.VerticalAlignment = xlCenter

[Steffl]

Hallo Ralf,

so hätte ich es gemacht, leider funktioniert WorksheetFunction noch nicht (die MsgBox-Zeilen sind nur zum ausprobieren):

wie heißt das Tabellenblatt? Im Beitrag vom TE steht Deckblatt, du hast im Code Tabelle1 stehen.

[Rabe]

Hi Stefan,

wie heißt das Tabellenblatt? Im Beitrag vom TE steht Deckblatt, du hast im Code Tabelle1 stehen.

es hieß Tabelle1, habe es (Blattname und Code) auf Deckblatt geändert. Fehler bleibt natürlich.

Vermutlich habe ich diese WorksheetFunction noch nicht richtig verstanden/angewendet.

  Arbeitspaket.xlsb (Größe: 17,85 KB / Downloads: 7)

[edit, 11:35]Datei aktualisiert!

[Rabe]

Hi,

Vermutlich habe ich diese WorksheetFunction noch nicht richtig verstanden/angewendet.

habe nun eine Lösung:

   Dim bereich1 As Range
   Dim bereich2 As Range
   Dim gesamtbereich1 As Range
   Dim bereich3 As Range
   Dim bereich4 As Range
   Dim bereich5 As Range
   Dim gesamtbereich2 As Range
   Dim loZeile As Long
   
   loZeile = Application.WorksheetFunction.Match("Summe:", Range("B24:B" & loZeile), 0) ' gibt Zeile im Suchbereich aus 
   loZeile = 24 + loZeile - 1       'Addition der Such-Startzeile, => Zeile der letzten Datenzeile vor "Summe:" 
'   MsgBox loZeile                   'Anzeige der Zahl zu Testzwecken 
   
   Set bereich1 = Range("B23:B" & loZeile)
   Set bereich2 = Range("C23:M23")
   Set gesamtbereich1 = Union(bereich1, bereich2)
   gesamtbereich1.HorizontalAlignment = xlCenter
   gesamtbereich1.VerticalAlignment = xlCenter
   
   Set bereich3 = Range("B" & loZeile + 2 & ":M" & loZeile + 2)
   Set bereich4 = Range("B3:M19")
   Set bereich5 = Range("C24:M" & loZeile)
   Set gesamtbereich2 = Union(bereich3, bereich4, bereich5)
   gesamtbereich2.HorizontalAlignment = xlLeft
   gesamtbereich2.VerticalAlignment = xlCenter

Geht bestimmt auch eleganter!

[Steffl]

Hallo Ralf,

ich habe auch eine Fehlermeldung erhalten und verstehe das Ganze auch nicht ganz (auch die OH zur dieser Funktion verstehe ich nicht). In diesem Beitrag hat snb (Beitrag #15) was dazu geschrieben. Verwende doch vom Range die Find-Methode.

[Rabe]

Hi Stefan,

In diesem Beitrag hat snb (Beitrag #15) was dazu geschrieben.

den Beitrag habe ich bei der Suche auch gefunden. Daraus schließe ich, daß Find einen String in einem String sucht und nicht in einer Zelle.

Mit Match klappt es nun. Die Datei habe ich mit dem neuen Code hochgeladen.

[ToXiC]

Hallo zusammen,

zunächst mal danke für Eure Mühen.

Also es ist kompliziert, mein Chef sagt: "Wenn es einfach wäre, dann hätte ich es selber gemacht."
Und ich hatte heute einen langen Tag und werde wohl auch langsam alt...

Ich werde die Tabelle hier mal anhängen, den Tabellenschutz so lassen, Passwort ist "PW"
Passwort für VBA: "VBAProtect"


Es ist so: Es sollen a) Nur Felder auswählbar sein, die auch Eingaben erfordern. So kann jedes Feld mit der Tab-Taste nacheinander ausgewählt werden, so der Wunsch.
Auszufüllen sind ALLE Felder, die sich mit dem aktivierten Blattschutz, wie ich es Euch zur Verfügung stelle, auswählen lassen. Jedes Feld kann theoretisch mehr Inhalt haben, als passt, weshalb die Zeilenhöhe automatisch angepasst werden soll.
Dadurch verschiebt sich ja jede weitere Zeile darunter nach unten.

Wunsch 2: Und ich bin schon total fertig...:
Der Bereich ab Arbeitsschritte/ Aktivitäten soll so funktionieren:
Man kann unter der Überschriften-Zeile 23 wenn nötig weitere Zeilen einfügen, wie alle Zellen wird auch hier die Zellenhöhe automatisch angepasst, sollte der Text das Zellenende überschreiten.
Diese Zeilen bei Spalte B sollten automatisch durchnummeriert werden.

Hierzu ist auch anzumerken: Sobald der bereich auf die zweite Seite rutscht, soll automatisch die Überschriftenzeile 23 vorangestellt werden (Kopie).

Wunsch 3:
Das Unterschriften-Feld Zeile 36 soll nicht getrennt werden können, weshalb ich es testweise mit verbundenen Zellen probiert habe.
Dieses Feld soll also immer am Ende stehen, möglichst immer in den letzten Zeilen einer Seite und nur auf der letzten Seite.

Alles habe ich selbst zusammengebastelt, aber mir fehlt das Know-How. Wenn es nicht auch darum geht, übernommen zu werden, würde ich nicht noch Zuhause sitzen und das bestmögliche probieren, um es dann abliefern zu können...



  Arbeitspaket.xlsm (Größe: 22,37 KB / Downloads: 3)

[Rabe]

Hi,

Alles habe ich selbst zusammengebastelt, aber mir fehlt das Know-How.

Wunsch 1 und 3 hast Du ja schon selber erledigt.
Nun schaue Dir mal diese Datei an:
  Arbeitspaket - Rabe V2.xlsb (Größe: 24,39 KB / Downloads: 7)

Und ich bin schon total fertig...:

Wunsch 2: eben, Du bist schon fast fertig damit. :D
In meinem vorigen Makrto war ja die Flexibilisierung der Arbeitsschritt-Formatierung schon drin.
Das Einfügen einer Zeile mittels einer Taste habe ich eingebaut.
Hier fehlt noch das Übertragen der Überschriftenzeile auf die nächste Druckerseite. Das wird etwas komplizierter, da es vom eingestellten Drucker abhängt. Da habe ich momentan keine Lösung, es wurde aber hier im Forum vor kurzem schon mal gelöst. Evtl. findet noch jemand anders den Beitrag und kann Dir helfen.

[ToXiC]

Oh man, das sieht schon richtig gut aus.

Aber jedesmal wenn ich nun ein Dokument öffne, zählt er in VBA die Module zusammen.
das geht irgendwann ins unendliche...