Office: Zahl in fortlaufende Nummerierung einfügen

Hallo zusammen,

ich habe folgendes Problem.

In einer Word Tabelle habe ich eine fortlaufenden Nummerierung.

Zwischendurch ist eine Zahl in der Reihe (in der Beispieldatei die 10 in Zeile 8)
Ich möchte diese Zahl per VBA in die Reihe eingliedern als nächste fortlaufende Nummer, d.H. es müsste jetzt fortlaufende Nummer 6 werden. Die Formartierung sollte genau wie die vorherige Nummerierung sein, linksbündig.

Ist dies mit einem Makro möglich?

Vielen Dank für eure Hilfe

Viele Grüße Ulli

 

Hallo Ulli,

dein Musterdokument ist komplett leer. Es wäre aber wichtig zu wissen, ob deine "fortlaufende Nummerierung" irgendwas automatisches ist, oder ob du die einfach reingetippt hast, und ob sie in Zeilen oder Spalten stehe. Im günstigsten Fall könntest du sämtliche Nummern aus dem Bereich entfernen, ihn markieren und eine automatische Nummerierung (Gliederung) aus dem Menüband zuweisen. Dass du da ein Makro brauchst, glaub ich erst mal nicht.

Wenn der Tipp dir nichts taugt, lad nochmal ein Musterdokument hoch.

 

Hallo Gehard,

die Nummerierung ist eine fortlaufende, automatische Nummerierung von Word.

Zwischen durch werden schon mal Zeilen gelöscht oder eine Nummerierung entfernt, und dann sollte schon mal, so wie in der Beispieldatei, eine Nummerierung ergänzt werden.
Jetzt der korrekte Anhang

Dadurch, das es teilweise viele Zeilen sind, ist ein manuelles Durchnummerieren sehr aufwendig, besonders weil nicht alle Werte in die Nummerierun einfließen sollen.

Gruß Ulli

 

Hallo Ulli,

versteh ich das richtig:

• Die komplett leeren Zellen (also weder Nummern noch Inhalt) sollen erhalten bleiben und auch keine Nummerierung kriegen
• Die Zellen, die keine Nummerierung haben UND statt dessen irgendeinen Inhalt, sollen statt des Inhalts eine Nummerierung (fortgesetzt) kriegen.
• Die weiter unten vorhandenen Nummern sollen sich anpassen

Wenn ich das richtig interpretiert habe, wende auf dein Musterdokument folgendes Makro an (vorher irgendwo in die Tabelle klicken)

Code:

'Schreibmarke irgendwo in die Tabelle setzen
Sub nummerierung()
Dim tabelle As Table
Dim i As Long

Set tabelle = Selection.Tables(1)

With tabelle
    For i = 1 To .Rows.Count
        If .Cell(i, 1).Range.ListFormat.ListType = 0 And _
            Len(.Cell(i, 1).Range) > 2 Then
          
            .Cell(i, 1).Range.Text = ""
            .Cell(i, 1).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
            ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
            True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
            wdWord10ListBehavior
        End If
    Next i
End With
End Sub

Ich hoffe, das funktioniert, denn ich steh mit diesen ListGalleries auf extremem Kriegsfuß.

 

Hallo Gerhard,

das funktioniert, super. Danke !!

Aber für meine Anwendung benötige ich es noch etwas verändert, ich werde mich später gerne noch einmal dazu melden.

Viele Grüße Ulli

 

Hallo Gerhard,

ich habe meinen Wunsch konkretisiert, siehe Beispieldatei.
Ich hoffe dies ist verständlich und umsetzbar.
Vielen Dank für die Unterstützung.

Gruß Ulli

 

Hallo Ulli,

kopiere dieses Makro ins Modul ThisDocument deines Musterdokuments und teste.

Code:

Sub fortlNr_v2()
Dim tabelle As Table
Dim i As Long, laufNr As Long, anzZeilen As Long

'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
    MsgBox "Bitte zuerst in die zu bearbeitende Tabelle klicken!"
    Exit Sub
End If

Set tabelle = Selection.Tables(1)
anzZeilen = tabelle.Rows.Count
laufNr = 0

With tabelle
    'Tabellenzeilen ab Zeile 2durchschleifen
    For i = 2 To anzZeilen
  
        'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
        If Len(.Cell(i, 2).Range) = 2 Then
            laufNr = laufNr + 1
            .Cell(i, 2).Range = laufNr
            'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
            .Cell(1, 1).Range.Copy
            .Cell(i, 1).Range.Paste
        End If
    Next i
End With
End Sub

Falls es so passt, nicht vergessen, das Dokument im Format *.docm zu speichern (oder, wenn das Original eine Dokumentvorlage (dotx) ist, dann halt als *.dotm).

 

Hallo Gerhard,

super, du bist genial, funktioniert einwandfrei, danke!!

Noch zwei Frage:
Frage1
Wenn ich den Code aufgerufen habe, und ich dann nachher irgendwo noch Zeilen einfüge, und ich den Code dort wiederholt aufrufe, wäre es schön, wenn sich die Nummerierung fortlaufend in die vorherige Nummerierung einfügt (aktuell fängt es dann wieder mit 1 an.

Frage 2
Wie müsste ich den geänderten Code (Frage1) ändern, dass die Eingabe nur in der Zeile erfolgt, in der der Cusor steht?
d.H. wenn ich in der Beispieldatei den Cursor in die Zeile 3 stelle, sollte nach aufrufen dann in der zweiten Spalte die Nr. 1
wenn ich den Cursor dann z.B. in die Zeile 8 Stelle und den Code noch einmal aufrufe, dann sollte dort in Spalte 2 die fortlaufende Nr. 2 stehen.

Danke für deine Hilfe
Gruß Ulli

 

Hallo Ulli,

Zusatzfrage 1 hab ich glaub ich hingekriegt, unter Verwendung der von mir ungeliebten Listgalleries (musst halt mal testen).

Zusatzfrage 2 versteh ich nicht. Die würde doch die eben mühsam erstellte laufende Nummerierung zerstören?
Wenn vorher 1,2,3,4...8 notiert ist sollte denn dann die neue Nummerierung 1,2,1,4...2 lauten? Wenn du das wirklich so meinst, muss ich wahrscheinlich passen, denn das wären quasi 2 ineinander verschachtelte, voneinander unabhängige Listen. Oder soll das ein Makro werden, das auf einen anderen Fall (eine andere Tabelle) angewendet werden soll?

Für die Frage 1 ersetze das bisherige Makro durch diese beiden (beide in ThisDocument kopieren):

Code:

Sub fortlNr_v3()
Dim tabelle As Table
Dim i As Long, laufNr As Long, anzZeilen As Long

'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
    MsgBox "Bitte zuerst in die zu bearbeitende Tabelle klicken!"
    Exit Sub
End If

Set tabelle = Selection.Tables(1)
anzZeilen = tabelle.Rows.Count
laufNr = 0

With tabelle
    'Tabellenzeilen ab Zeile 2durchschleifen
    For i = 2 To anzZeilen

        'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
        If Len(.Cell(i, 2).Range) = 2 Or _
        .Cell(i, 2).Range.Paragraphs(1).Style = "Listenformat" Then
           
           'Laufende Nummern ergänzen bzw. anpassen
           Call laufNum(i, tabelle)

         
            'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
            .Cell(1, 1).Range.Copy
            .Cell(i, 1).Range.Paste
        End If
    Next i
End With
End Sub

Sub laufNum(j, tabell)

    With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1"
        .TrailingCharacter = wdTrailingNone
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = 0
        .StartAt = 1
    End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
tabell.Cell(j, 2).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
    True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
    wdWord10ListBehavior
End Sub

 

Hallo Gerhard,

das funktioniert schon mal super, ganz große Klasse!! herzlichen Dank

Die Frage 2 zielt darauf hin, das nicht alle Zeilen eine Nummerierung bekommen sollen, sonder nur die Zeilen, in der der Cursor steht und das Makro aufgerufen wurde.
d.H. steht der Cursor z.B. in Zeile 3 und ich rufe das Makro auf, wird eine neue Nummerierung erzeugt aber nur in dieser Zeile.
Wenn ich dann den Cursor z.B. in Zeile 8 setze und dort das Makro aufrufe, sollte in der Zeile 8 die Nummerierung fortgesetzt werden (entsprechend die Nummer 2)
Wenn das klappen würde wäre es perfekt

Viele Grüße Ulli

 

Hallo Ulli,

deine Erklärung aus #10 bringt mir im Vergleich zu der aus #8 keine neue Erkenntnis. Deshalb frag ich nochmal anders nach:

• Ist deine Vorstellung, dass man das bisherige Makro so ändert, dass beide Zusatzfragen in einem Aufwasch erledigt werden können? Da seh ich schwarz.
• Wenn es für Frage 2 ein eigenes Makro geben darf: Willst du das auf dieselbe Tabelle anwenden, auf die du die Sub fortlNr_v3() anwendest oder auf eine andere?
• Falls ersteres: Willst du das Makro für die Frage 2 zusätzlich zum vorhandenen Makro anwenden oder stattdessen?
• Falls ersteres: Ist es dann gewollt, dass die durch das erste Makro hergestellte fortlaufende Nummerierung zerstört wird (sieh #8: Wenn vorher 1,2,3,4...8 notiert ist sollte denn dann die neue Nummerierung 1,2,1,4...2 lauten?

Du siehst, ich bin reichlich desorientiert. Du hast doch so ein schönes Musterdokument mit vorher/nachher erstellt. Könntest du das so erweitern, dass ich das gewünschte Endergebnis sehen kann?

 

Hallo Gerhard,

danke für deine Rückmeldung.
1. nur Frage Nummer 2 soll durch das Makro ausgeführt werden
2. Ausführung in einer anderen Tabelle
3. Nicht zum vorhandenen Makro, sondern stattdessen

Ich habe es versucht in der Beispieldatei zu beschreiben.

Viele Grüße Ulli

 

Hallo Ulli,

jetzt seh ich klarer. Was ich hinkriege, ist die Fortsetzung der Liste nach unten (also genau dein Beispiel), und die Anpassung der Liste, wenn du eine nummerierte Zeile löschst.

Was ich aber nicht hinkriege, ist die Anpassung einer vorhandenen Nummerierung, wenn du das Makro in einer Zeile oberhalb einer schon vorhandenen Nummerierung startest. Wenn das auch gewünscht wird, muss man vermutlich einen ganz anderen Ansatz fahren, den ich mir aber noch nicht überlegt habe.

Hier die beiden Makros:

Code:

Sub fortlNr_v4()
Dim tabelle As Table

'Hinweis und ggf Abbruch
If Selection.Information(wdWithInTable) = False Then
    MsgBox "Bitte zuerst eine ganze Tabellenzeile markieren!"
    Exit Sub
End If

If Selection.Cells.Count <> Selection.Information(wdMaximumNumberOfColumns) Then
    MsgBox "Bitte zuerst eine ganze Tabellenzeile markieren!"
    Exit Sub
End If

With Selection
    Set tabelle = .Tables(1)
    
        'leere Zellen in der Spalte 2 mit einer fortlaufenen Nummer füllen'
        If Len(Selection.Cells(2).Range) = 2 Or _
        Selection.Cells(2).Range.Paragraphs(1).Style = "Listenformat" Then
            
           'Laufende Nummern ergänzen bzw. anpassen
           Call laufnum2
          
            'Inhalt der ersten Zelle links neben die bearbeitete Zelle kopieren
            tabelle.Cell(1, 1).Range.Copy
            Selection.Cells(1).Range.Paste
        End If
End With
End Sub
Sub laufnum2()
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1"
        .TrailingCharacter = wdTrailingNone
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = 0
        .StartAt = 1
    End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Cells(2).Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
    True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
    wdWord10ListBehavior
End Sub

 

Hallo Gerhard,

das ist spitze !! Ganz herzlichen Dank!
Wäre der code noch so veränderbar, dass es außreichend ist, wenn der Cursor in der Zeile steht und nicht die ganze Zeile markiert werden muss?

Viele Grüße Ulli

 

Hallo Gerhard,

ich habe dies jetzt noch davor gesetzt. Funktioniert
Selection.Rows(1).Select
Oder würdest du es anders machen?
Gruß Ulli