Office: (Office 2016) Word Makro für Tabellen mit Auswahlliste

Hi Gerhard,

es funktioniert soweit nun alles bis auf dein Makro.
Egal was ich versuche es macht beim Ausführen nichts zumindest bei mir nicht.

Habe versucht es als neues Makro einzufügen, dann erhalte ich immer eine Fehlermeldung: "Fehler beim Kompilieren: Sub oder Function nicht definiert"
Aber auch wenn ich es versuche in deinem Dokument auszuführen passiert nichts, es wird keine neue Zeile erstellt.

Hier mal meine Makros die derzeit existieren:

Code:

Sub Zeile_Hinzufügen()

 Dim doc As Word.Document
 Dim tabelle As Word.Table, Zeile As Word.Row
 Dim ctTab As Long, ctZl As Long, Formel$
     
   Set doc = ActiveDocument
   With doc
     ctTab = .Tables.Count    'Anzahl Tabellen im Dokument
     With .Tables(ctTab)      'In der letzten Tabelle ...
       Set Zeile = .Rows.Add  'wird eine neue Zeile angefügt
       ctZl = .Rows.Count     'Anzahl Zeilen dieser Tabelle
       With Zeile
         With .Shading        'Diese Zeile formatieren
           .Texture = wdTextureNone
           .ForegroundPatternColor = wdColorAutomatic
           .BackgroundPatternColor = wdColorWhite
         End With
         'Vorbesetzung der Zellen mit Werten und Formel/Format:
         .Cells(1).Range.Text = ctZl - 1
       
         .Cells(4).Range.Text = 1
                   Formel$ = Replace("=Z@S3*Z@S4", "@", ctZl)
         .Cells(5).Formula Formula:=Formel$, numformat:="#.##0,00 €;-#.##0,00 €"
       End With
     End With
   End With
End Sub


Sub Formeln_Korrigieren()

Dim doc As Word.Document
Dim tabelle As Word.Table, Zeile As Word.Row, RgFeld As Word.Range
Dim ctTab As Long, ctZl As Long, Formel$
  
  Set doc = ActiveDocument
  With doc
    ctTab = .Tables.Count
    With .Tables(ctTab)
      For Each Zeile In .Rows
        With Zeile
          ctZl = .Index
          If ctZl <> 1 Then
             .Cells(1).Range.Text = ctZl - 1
             
             Set RgFeld = .Cells(5).Range
             RgFeld.MoveEnd Unit:=wdCharacter, Count:=-1
             Formel$ = Replace("=Z@S3*Z@S4", "@", ctZl) & " \# ""#.##0,00 €;-#.##0,00 €"""
             doc.Fields.Add Range:=RgFeld, Type:=wdFieldEmpty, Text:=Formel$, preserveformatting:=False
           End If
        End With
      Next Zeile
    End With
  End With
End Sub


Sub zeileAnfuegen()

Dim doc As Document
Dim ctab As Long, letzteZeile As Long
Dim formel_1 As String, formel_2 As String, formel_3 As String, format As String

Set doc = ActiveDocument
ctab = doc.Tables.Count

    With Tables(ctab)
        letzteZeile = .Rows.Count 'Letzte Zeile bestimmen
        .Rows(letzteZeile).Range.Copy 'letzte Zeile kopieren und Einfügen
        .Rows(letzteZeile).Range.PasteAndFormat (wdFormatOriginalFormatting)
        letzteZeile = .Rows.Count 'letzte Zeile neu bestimmen
        
        'eingefügte Zeile anpassen:
        .Cell(letzteZeile, 1).Range.Text = letzteZeile - 1                  'Spalte 1
        .Cell(letzteZeile, 2).Range.ContentControls(1).Range.Text = ""      'Spalte 2
        .Cell(letzteZeile, 3).Range.Text = 0                                'Spalte 3
        .Cell(letzteZeile, 4).Range.Text = 1                                'Spalte 4
        
        'Formel der letzten Zelle anpassen                                  'Spalte 5
        formel_1 = "=Product(C"
        formel_2 = ";D"
        formel_3 = ") "
        format = "\# " & """ #.##0,00 €;-#.##0,00 €"""
    End With


    With doc
        'Fortsetzung Formel anpassen
        .Fields.Add Range:=.Range( _
        Start:=.Tables(ctab).Cell(letzteZeile, 5).Range.Start, End:=.Tables(ctab).Cell(letzteZeile, 5).Range.End - 1) _
        , Type:=wdFieldEmpty, _
        Text:=formel_1 & letzteZeile & formel_2 & letzteZeile & formel_3 & format
     End With
End Sub

 

Hallo Gerhard,

irgendwie wurde meine Antwort von gestern wohl nicht gespeichert... doof.
Aber dann schreib ich nochmal.

Das mit der Dropdown Erweiterung habe ich hinbekommen.

Leider funktioniert das Makro welches du geschrieben hast bei mir nicht.
Sobald ich es Ausführe passiert im Dokument nichts

Habe es auch nochmal neu bei mir eingebaut aber nur meine zwei Makros funktionieren...

Code:

Sub Zeile_Hinzufügen()

   Dim doc As Word.Document
   Dim tabelle As Word.Table, Zeile As Word.Row
   Dim ctTab As Long, ctZl As Long, Formel$
     
   Set doc = ActiveDocument
   With doc
     ctTab = .Tables.Count    'Anzahl Tabellen im Dokument
     With .Tables(ctTab)      'In der letzten Tabelle ...
       Set Zeile = .Rows.Add  'wird eine neue Zeile angefügt
       ctZl = .Rows.Count     'Anzahl Zeilen dieser Tabelle
       With Zeile
         With .Shading        'Diese Zeile formatieren
           .Texture = wdTextureNone
           .ForegroundPatternColor = wdColorAutomatic
           .BackgroundPatternColor = wdColorWhite
         End With
         'Vorbesetzung der Zellen mit Werten und Formel/Format:
         .Cells(1).Range.Text = ctZl - 1
       
         .Cells(4).Range.Text = 1
                   Formel$ = Replace("=Z@S3*Z@S4", "@", ctZl)
         .Cells(5).Formula Formula:=Formel$, numformat:="#.##0,00 €;-#.##0,00 €"
       End With
     End With
   End With
End Sub

Sub zeileAnfuegen()

Dim doc As Document
Dim ctab As Long, letzteZeile As Long
Dim formel_1 As String, formel_2 As String, formel_3 As String, format As String

Set doc = ActiveDocument
ctab = doc.Tables.Count

    With Tables(ctab)
        letzteZeile = .Rows.Count 'Letzte Zeile bestimmen
        .Rows(letzteZeile).Range.Copy 'letzte Zeile kopieren und Einfügen
        .Rows(letzteZeile).Range.PasteAndFormat (wdFormatOriginalFormatting)
        letzteZeile = .Rows.Count 'letzte Zeile neu bestimmen
        
        'eingefügte Zeile anpassen:
        .Cell(letzteZeile, 1).Range.Text = letzteZeile - 1                  'Spalte 1
        .Cell(letzteZeile, 2).Range.ContentControls(1).Range.Text = ""      'Spalte 2
        .Cell(letzteZeile, 3).Range.Text = 0                                'Spalte 3
        .Cell(letzteZeile, 4).Range.Text = 1                                'Spalte 4
        
        'Formel der letzten Zelle anpassen                                  'Spalte 5
        formel_1 = "=Product(C"
        formel_2 = ";D"
        formel_3 = ") "
        format = "\# " & """ #.##0,00 €;-#.##0,00 €"""
    End With


    With doc
        'Fortsetzung Formel anpassen
        .Fields.Add Range:=.Range( _
        Start:=.Tables(ctab).Cell(letzteZeile, 5).Range.Start, End:=.Tables(ctab).Cell(letzteZeile, 5).Range.End - 1) _
        , Type:=wdFieldEmpty, _
        Text:=formel_1 & letzteZeile & formel_2 & letzteZeile & formel_3 & format
     End With
End Sub

Sub Formeln_Korrigieren()

Dim doc As Word.Document
  Dim tabelle As Word.Table, Zeile As Word.Row, RgFeld As Word.Range
  Dim ctTab As Long, ctZl As Long, Formel$
  
  Set doc = ActiveDocument
  With doc
    ctTab = .Tables.Count
    With .Tables(ctTab)
      For Each Zeile In .Rows
        With Zeile
          ctZl = .Index
          If ctZl <> 1 Then
             .Cells(1).Range.Text = ctZl - 1
             
             Set RgFeld = .Cells(5).Range
             RgFeld.MoveEnd Unit:=wdCharacter, Count:=-1
             Formel$ = Replace("=Z@S3*Z@S4", "@", ctZl) & " \# ""#.##0,00 €;-#.##0,00 €"""
             doc.Fields.Add Range:=RgFeld, Type:=wdFieldEmpty, Text:=Formel$, preserveformatting:=False
           End If
        End With
      Next Zeile
    End With
  End With
End Sub

Wenn ich dein Makro ausführe erhalte ich immer eine Fehlermeldung: Fehler beim Kompilieren: Sub oder Function nicht definiert


Gruß
Mel

 

Hallo Mel,

bei mir funktioniert das Zeilen hinzufügen. Vielleicht ist es ein Missverständnis: Momentan musst du dieses Makro händisch aufrufen (über Entwicklertools > Makros, oder über den VBA-Editor. Das kann man später per Schaltfläche machen lassen.

Was allerdings nicht zur Zufriedenheit funktioniert (vielleicht hast du es noch nicht bemerkt): Da du die Zusatztexte nicht mehr in das Control schreiben lässt, sondern dahinter (was ich dir eh vorschlagen wollte), wird momentan der alte Zusatztext nicht gelöscht, sondern der neue wird einfach hinten dran gehängt.

Um das zu vermeiden hab ich eine weitere Spalte für den Zusatztext eingefügt, mit der Folge, dass ich die Spalten in den beiden Makros alle anpassen musste.

Deshalb hier dein geändertes Dokument zurück. Die Tabelle enthält nur 1 Datenzeile, also beginne mit Zeile hinzufügen.

Es gibt noch einen Mangel: Momentan aktualisiert sich der Preis nicht, wenn man die Anzahl ändert. Das könnte man leicht beheben und ich mach dir gern dazu einen Vorschlag. Aber jetzt muss erst mal das Zeile hinzufügen klappen.

 

Hallo Mel,

es geht grad wohl ein bisschen durcheinander hier, und das mit der Fehlermeldung Sub oder Function nicht definiert hab ich jetzt erst gelesen. Also: Um die Fehlermeldung richtig einordnen zu können, musst du sie im Einzelschritt (mit F8) durchlaufen lassen und mir die Zeile sagen, die dann gelb unterlegt ist.

Aber ich hab eine Vermutung: Das Makro will ja das Inhaltssteuerelement in der jeweils letzen Zeile vom Inhalt befreien. Aber in deinem Musterdokument ist die letzte Zeile ohne Inhaltssteuerelement.

In meinem (zumindest in dem letzten) gibts nur eine, aber dafür vollständig gefüllte Zeile. Deshalb dürfte mein letztes Musterdokument bei dir auch funktionieren, aber deins nicht.

Moral von der Geschicht: die letzte Zeile muss in Spalte 2 immer ein Inhaltssteuerelement mit dem Tag "Leistung" haben.

 

Hi Gerhard,

ja nun ist irgendwie alles durcheinander. Warum auch immer wurden meine Antworten verzögert im Forum hochgeladen.

Ich würde nochmal komplett versuchen zusammenzufassen:

Das Dokument: "Rechnung4a" enthält genau die Dropdown die ich brauche.
Es wird ein Artikel ausgewählt und der entsprechend hinterlegte Text bei Leistung und der hinterlegte Preis bei Einzelpreis in die Tabelle geschrieben.
Sprich in der Dropwon steht z.B.
Case "oApfel"
preis = 0.99
zusatztext = " Apfel 1"
In der Tabelle steht dann
Leistung = Apfel 1
Einzelpreis = 0,99€


Das Dokument: "rechnung neu2" enthält das Makro um eine neue Zeile + Dropdown einzufügen.


Ich habe mir damals ein Makro geschrieben um die Zeilen bzw. Rechenformeln zu korrigieren. Sprich es wird geprüft ob vorne die Positionsnummern stimmen und hinten der Gesamtpreis entsp. berechnet.

Code:

Sub Formeln_Korrigieren()
  Dim doc As Word.Document
  Dim tabelle As Word.Table, Zeile As Word.Row, RgFeld As Word.Range
  Dim ctTab As Long, ctZl As Long, Formel$
  
  Set doc = ActiveDocument
  With doc
    ctTab = .Tables.Count
    With .Tables(ctTab)
      For Each Zeile In .Rows
        With Zeile
          ctZl = .Index
          If ctZl <> 1 Then
             .Cells(1).Range.Text = ctZl - 1
             
             Set RgFeld = .Cells(5).Range
             RgFeld.MoveEnd Unit:=wdCharacter, Count:=-1
             Formel$ = Replace("=Z@S3*Z@S4", "@", ctZl) & " \# ""#.##0,00 €;-#.##0,00 €"""
             doc.Fields.Add Range:=RgFeld, Type:=wdFieldEmpty, Text:=Formel$, preserveformatting:=False
           End If
        End With
      Next Zeile
    End With
  End With
End Sub

Jetzt müsste man eine Kombi aus den drei Funktionen bauen.

Am Ende würde ich gerne aus der Dropdown meinen Artikel auswählen. Leistung und Einzelpreis werden entsprechend gefüllt (Dok: Rechnung4a).
Die Anzahl kann ich manuell Ändern.
Der Gesamtpreis müsste dann über ein Makro korrigiert werden.
Sollten es mehrere Artikel sein würde ich gerne eine neue Zeile einfügen bei der die Dropdown auch direkt sichtbar ist (Dok: rechnung neu2)

 

Hallo Mel,

da dir die Variante 4a am besten passen würde, hab ich die nochmal hergenommen, und dein Makro in meine integriert.

Dabei ist mir aufgefallen, dass ich dir leider eine fehlerbehaftete Version hochgeladen hab, die immer eine Zeile ohne Inhaltssteuerelement hinzugefügt hatte, was den von dir beklagten Fehler verursachte. Meine diesbezügliche Erklärung kannst du deshalb ignorieren. Der Fehler ist jetzt behoben.

Damit bei Eingabe von Einzelpreis und Anzahl die Summe automatisch aktualisiert werden kann, hab ich in den entsprechenden Spalten ebenfalls Inhaltssteuerelemente eingefügt, um dafür das OnExit-Makro nutzen zu können. Das hab ich dementsprechend geändert.
Weitere Hinweise im Dokument selber.

Ich hoffe mal, dass jetzt alles funktioniert, dann kann man sich ja noch über die Feinheiten machen.

 

Hallo Gerhard,

das Dokument funktioniert. Dropdown, Zeile hinzufügen, Gesamtpreis aktualisieren. Super. Vielen lieben Dank.

Nur mit dem Löschen einer Zeile habe ich Probleme. Evtl. meinst du noch einen anderen Entwurfsmodus?
Ich erhalte folgende Meldung:


Danke & Lieben Gruß
Mel

 

Hallo Mel

ich meinte die Entwurfsansicht in den Entwicklertools. Da ich in deinem Screenshot diese Registerkarte gar nicht eingeblendet sehe, vorsorglich noch der Hinweis: Die blendest du ein über Datei > Optionen > Menüband anpassen > Hauptregisterkarten.

Ein Problem ist mir bisher noch entgangen. Du hast ja auch die fortlaufende Nummer per Schleife überprüfen lassen und ich wusste gar nicht, warum. Vermutlich wegen des Löschens von Zeilen. Das würde ich jetzt anders machen: Es könnte ein weiteres Makro geben, das die Zeilen löscht und die laufende Nummer automatisch aktualisiert. Wenn man dafür ein weiteres Symbol in der Schnellstartleiste anbringt, müsstest du dich nicht um die Entwurfsansicht kümmern.

Ich könnte dir das einbauen, aber frühestens heute abend. Jetzt gehts erst mal in die Sonne.

 

Hi Gerhard,

sehr gerne. Eilt nicht. Genieß erstmal die Sonne.

Vielen Dank

 

Hallo Mel,

hier die Variante mit Löschmakro. Starten über die entsprechende Schaltfläche in der Schnellzugriffsleiste. Vor dem Starten die Schreibmarke irgendwo in die zu löschende Zeile setzen.

Sehr ausführlich getestet hab ich es nicht, also wenn was ist, meld dich wieder.

 

Funktioniert soweit alles bestens. Zumindest das was ich bis jetzt gesehen habe. Ich mach mich mal ans befüllen. Vielen vielen Dank (auch für deine Geduld)
Ich wünsche dir auf diesem Weg schon einmal Frohe Ostern.

 

Hi Gerhard,

kannst du mir erklären wie man die Schaltflächen in die Schnellzugriffleiste bekommt.

Danke

Gruß
Mel

 

Hallo Mel,

ich hab ein hübsches Bild davon. Beachte besonders - da es sich bei dir um eine Dokumentvorlage handelt - die Erklärung zum Punkt 1.

 

Hallo Gerhard,

es funktioniert alles bestens. Vielen Dank.
Eine Weitere Frage hätte ich noch:
Ist es machbar die Gesamtsumme der Spalte "Gesamtpreis" in einem sich unten befinden Textfeld berechnen zu lassen?

Danke & Gruß
Mel

 

Hallo Mel,

es gibt jetzt eine Zeile für die Gesamtsumme, in deren letzter Zelle das Feld Sum(above) eingetragen ist.

Bei der Gelegenheit musste ich die bisherigen Makros ein wenig ändern. Vor allem hab ich für das Löschmakro noch einige Prüfungen hinzugefügt, damit auch keiner versehentlich was falsches löschen kann.
Nähere Erklärungen wieder im Dokument (das ich wieder zur Dokumentvorlage gemacht hab)