Vbalösung Word-Tabelle Zellen einfügen
Adresse A Adresse B
Adresse C Adresse D
Adresse E Adresse F
usw.
Nun soll z. B. eine „Adresse A2“ zwischen „Adresse A“ und
„Adresse B“ eingefügt werden, wodurch B auf den Platz von C, C
auf den Platz von D, D auf den Platz von E usw. rücken soll.
Hallo Jacqueline,
hier ist eine doc die vielleicht das macht was du möchtest.
Das Doc besteht quasi nur aus einer Wordtabelle, zweispaltig.
Es gibt noch zwei Schaltflächen zum Anklcken.
Mit „Fülle“ füllst du die bestehende Tabelle mit neuen alphabetischen Daten.
„Einfügen“ klickst du dann an wenn du in der Tabelle in einer beliebigen Zelle stehst. Das Makro verschiebt alle nachfolgenden Zellen, löscht den Inhalt dieser Zelle und markiert sie.
In deinem Fall müßtest du nur die Zelle mit „Adresse B“ markieren, dann auf „Einfügen“ klicken.
Steht der Curser bei Klick auf „Einfügen“ außerhalb der Tabelle im Text, reagiert das Makro nicht, das soll ja so sein.
Fr Interessierte oder wenn der Link irgendwann nicht mehr geht nachfolgend die Codes.
Getestet mit Word 2000.
Gruß
Reinhard
in Modul1:
Option Explicit
Sub tt()
Dim aktZei As Long, aktSpa As Long, Zei As Long, Spa As Long
Dim Eingef As Boolean
With ActiveDocument.Tables(1)
If Selection.Information(wdWithInTable) = False Then Exit Sub
aktZei = Selection.Information(wdEndOfRangeRowNumber)
aktSpa = Selection.Information(wdEndOfRangeColumnNumber)
If .Cell(.Rows.Count, 2).Range.Text "" Then
Eingef = True
.Rows(.Rows.Count).Select
Selection.InsertRowsBelow 1
End If
Spa = 2
For Zei = .Rows.Count To aktZei + 1 Step -1
.Cell(Zei, 2).Range.Text = .Cell(Zei, 1).Range.Text
.Cell(Zei, 1).Range.Text = .Cell(Zei - 1, 2).Range.Text
Next Zei
If aktSpa = 2 Then
.Cell(aktZei, 2).Range.Text = ""
.Cell(aktZei, 2).Select
Else
.Cell(aktZei, 2).Range.Text = .Cell(aktZei, 1).Range.Text
.Cell(aktZei, 1).Range.Text = ""
.Cell(aktZei, 1).Select
End If
If Eingef = True Then
If .Cell(.Rows.Count, 1).Range.Text = "" Then
If .Cell(.Rows.Count, 2).Range.Text = "" Then
.Rows(.Rows.Count).Delete
End If
End If
End If
End With
End Sub
Sub fuelle()
Dim Zei, N
N = 65
With ActiveDocument.Tables(1)
For Zei = 1 To .Rows.Count
.Cell(Zei, 1).Range.Text = String(10, Chr(N))
.Cell(Zei, 2).Range.Text = String(10, Chr(N + 1))
N = N + 2
Next Zei
End With
End Sub
In Thisdokument:
Option Explicit
Private Sub CommandButton1_Click()
Call tt
End Sub
Private Sub CommandButton2_Click()
Call fuelle
End Sub
