Inhalt eine Tabellenzelle per VBA kopieren

Moderator: ModerationP

Inhalt eine Tabellenzelle per VBA kopieren

Beitragvon Wurschtel » 05. Mär 2019, 20:16

Hallo Schwarmwissen!

Ich komme einfach nicht weiter.
Im Rahmen einer VBA-Routine suche ich mir eine Tabellenzelle und möchte deren Inhalt FORMATIERT weiterverarbeiten.
Die betreffenden Zellen als solche zu finden und zu markieren ist kein Problem. Es wird aber immer die ganze Zelle kopiert und beim Einfügen des Inhalts an anderer Stelle habe ich eine 1x1-Tabelle, also genau die kopierte Zelle.
In den einzelnen Zellen sind ganz wild formatierte Textbausteine mit Hoch/Tiefstellung usw. Der Weg über Textmarken funktioniert nicht, weil mir diese im Zusammenhang mit includetext / rtf-formatiert andere Probleme bereitet.
Über
ActiveDocument.Tables(I).Rows(Zeile).Cells(Spalte + 2).Range.Copy

komme ich auf die Zelle und denke, daß es an der Range-Option liegt. Aber alles was ich da probiert habe, schlug fehl.
Wer kann mir helfen?

Danke & Gruß
Thomas
Wurschtel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8
Registriert: 05. Mär 2019, 19:53

Re: Inhalt eine Tabellenzelle per VBA kopieren

Beitragvon theoS » 05. Mär 2019, 22:16

Code: Alles auswählen
Sub copTab()
Dim dd1 As Document: Set dd1 = ActiveDocument
Dim tA As Table: Set tA = dd1.Tables(1)
Dim rC
tA.Cell(2, 2).Range.FormattedText.Select
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
Selection.EndKey unit:=wdStory, Extend:=wdMove
Selection.Paste
End Sub
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4733
Registriert: 19. Apr 2008, 00:14

Re: Inhalt eine Tabellenzelle per VBA kopieren

Beitragvon Wurschtel » 06. Mär 2019, 14:03

Hallo theoS,

habe es gerade umgesetzt und es funktioniert im Prinzip GENIAL - ganz herzlichen Dank!
Ein klitzekleines Problem habe ich allerdings noch:

Dank deiner genialen Zeilen

Code: Alles auswählen
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy

habe ich nun also den formatierten Zelleninhalt in der Zwischenablage. Richtig?
Nun wechsele ich in das andere Dokument, suche und selektiere den Marker "strBaustein" und ersetze ihn mit

Code: Alles auswählen
With Word.Application.Selection.Find
   .Text = strBaustein
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
End With
Word.Application.Selection.Find.Execute 'Replace:=wdReplaceAll
Selection.PasteAndFormat (wdPasteDefault)

Das kleine Problemchen ist nun, daß es den Marker "strBaustein" mehrmals im anderen Dokument gibt.
Führe ich den code mit

Code: Alles auswählen
Word.Application.Selection.Find.Execute

aus, wird beim ersten Auftreten von "strBaustein" alles richtig umgesetz.
Mache ich es jedoch mit

Code: Alles auswählen
Word.Application.Selection.Find.Execute Replace:=wdReplaceAll

wird nichts umgesetzt. Alle Marker "strBaustein" bleiben untouched.

Ob du mir da auch noch einmal bitte helfen könntest?

Gruß
Thomas
Wurschtel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8
Registriert: 05. Mär 2019, 19:53

Re: Inhalt eine Tabellenzelle per VBA kopieren

Beitragvon theoS » 07. Mär 2019, 12:21

Nun wechsele ich in das andere Dokument, suche und selektiere den Marker "strBaustein" und ersetze ihn mit


mit was?
nicht mit der Zwischenablage.

Wenn du das haben möchtest, dann musst du die Suche in eine Loop-Schleife einbauen.
Replace ersetzt dir hier normal deinen Suchbegriff durch nichts, also ""

Edit:
mit dem Code sollte das gehen, dass alle deine Suchtexte durch die Zwischenablage ersetzt werden:
Code: Alles auswählen
Sub Makro5()
'
' Makro5 Makro
'
'
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
    .Text = "Text"
    .Replacement.Text = "^c" 'das ist der Inhalt der zwischenablage
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With

  Selection.Find.Execute Replace:=wdReplaceAll
End Sub
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4733
Registriert: 19. Apr 2008, 00:14

Re: Inhalt eine Tabellenzelle per VBA kopieren

Beitragvon Wurschtel » 09. Mär 2019, 11:31

Nein, nein ... mit "Zwischablage" meine ich schon den vorher ausgelesenen Wert.

Der Inhalt der Variablen strBaustein ist von 00 bis 30 indiziert. Hierzu wird ersten Schritt in Column(1) der Tabelle(i) nach dem Index gesucht und die Variable strgBaustein mit dem Inhalt aus Spalte 2 der entsprechenden Zeile belegt.
Danach geht's dann in die Do-Loop, in der nach einem Auftreten immer wieder an den Anfang gesprungen und erneut gesucht wird. Wird nichts mehr gefunden, wird die Loop verlassen.

Ist zwar nicht die eleganteste Lösung, aber funktioniert im Moment ohne dass sich die Loop ins Nirwana verirrt.

Code: Alles auswählen
For iCount = 1 To 30
    strBaustein = "BTEN" & Format(iCount, "##00")
    docTextBausteine.Activate
        For Each celTable In docTextBausteine.Tables(i).Columns(1).Cells
            Set rngTable = docTextBausteine.Range(Start:=celTable.Range.Start, End:=celTable.Range.End - 1)
            If rngTable.Text = Right(strBaustein, 2) Then
                rngTable.Select
                Zeile = Selection.Cells(1).RowIndex
                docTextBausteine.Tables(i).Cell(Zeile, 3).Range.FormattedText.Select
                Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                Selection.Copy
                Exit For
            End If
        Next celTable
    docSeriendruck.Activate
    Selection.WholeStory
    'Selection.Fields.Update
     
    Do
        With Selection.Find
         .ClearFormatting
         .Text = strBaustein
         .Execute Forward:=True
        End With
       
        If Selection.Find.Found Then
            With Selection.Find
                .Text = strBaustein
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
            End With
            'Selection.Find.Execute 'Replace:=wdReplaceAll
            Selection.PasteAndFormat (wdPasteDefault)
            Selection.Collapse wdCollapseStart
        Else
            'MsgBox strBaustein & " nicht mehr gefunden"
            Exit Do
        End If
    Loop
Next iCount
Wurschtel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 8
Registriert: 05. Mär 2019, 19:53


Zurück zu Word Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste

cron