Excel: Word Dokument beschriften

[Stefan1]

Guten Tag miteinander
ich möchte ein Word-Formular aus dem Excel beschriften. Auf diese Word-Vorlage habe ich keinen Einfluss. Nun habe ich folgendes Problem, welches ich in etwas wie folgt simulieren kann.

Wenn ich in einem Word-Dokument folgenden Code laufen lasse, welcher ein AutoText (AUTHOR)-Feld eröffnet, dann bin ich mit allen Mitteln nicht in der Lage, dieses mit VBA-Code aus dem Excel wieder zu finden, noch zu ändern, noch sonst was.

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="AUTHOR  ", PreserveFormatting:=True

Wer weiss Rat mit einem AutoText-Feld, dass keinen Namen hat und ich auch nicht entsprechend manipulieren darf oder kann. Vielen Dank für Eure Unterstützung.
Ich habe es mit folgenden Code-Snips versucht, jedoch erfolglos:

Code:

Sub TEST()
Dim objAppWord As Object
Dim objWordDoc As Object
Dim oStory As Object
Dim cc As Object
Dim pp As Object
Dim y As Integer
 
    On Error Resume Next
    Set objAppWord = GetObject(, "Word.Application")
    On Error GoTo 0
    If objAppWord Is Nothing Then Set objAppWord = CreateObject("Word.Application")
    objAppWord.visible = True
    objAppWord.Activate
    Set objWordDoc = objAppWord.Documents.Add(Template:=CON_Temp14Word)
    With objWordDoc
        'For Each pp In .Paragraphs
            'pp.Range.Select
            'For Each cc In pp.Range.FormFields
            For Each cc In .FormFields
                With cc
                    If .Type = 70 Then
                        'Normaler Text
                        If .TextInput.Type = 0 Then
                            If y = 1 Then
                                .Result = „Test“
                            Else
                                '.Result = y    'Test
                            End If
                        'Datum
                        ElseIf .TextInput.Type = 2 Then
                        'Zahl
                        ElseIf .TextInput.Type = 1 Then
                        End If
                    End If
                End With
            Next
            For Each cc In pp.Range.Bookmarks
                If cc.Name = "AUTHOR" Then
                End If
            Next cc
            'For Each cc In pp.Range.ContentControls
            For Each cc In .ContentControls
                Select Case cc.tag
                Case Is = "AUTHOR"
                End Select
            Next cc
        'Next
    End With
    Set objWordDoc = Nothing: Set objAppWord = Nothing
End Sub

[Stefan1]

Guten Tag miteinander
Habe Ihr VBA-Fachleute wirklich keine Idee, wie das gelöst werden könnte?
Grüsse
Stefan1

[snb]

Ohne Beispieldatei ist das doch keine ernste Frage ?

Wieviel Leute hast du schon geholfen seit 2015 ?

[Stefan1]

Guten Tag snb

Ich habe einen im Excel lauffähigen VBA-Teil veröffentlich (Laufwerk CON_Temp14Word muss noch deklariert werden). Ebenso habe ich für die Simulation den Code beigefügt, der im Word das notwendige Feld dazu erzeugt. Mehr habe ich auch nicht dazu bzw. da fängt ja gleich das tüfteln, wissen oder unmöglich ja eben an.

In diesem neuen Forum habe ich noch nicht geholfen, in der frühesten Version jedoch schon. Wenn ich eine Lösung selber gefunden habe, dann habe ich diese oft ausführlich dokumentiert, dass auch andere davon profitieren konnten. Ich bin jedoch kein MVP, sondern nur ein Anwender von VBA, der so manches herausgefunden hat und auch hier wertvolle Typs bekommen habe. Manchmal dauert es etwas bis ich nachschaue, doch ich schaue nach und kommentiere oder bedanke früher oder später :17: .

Vielen Dank für Eure Bemühungen.

Liebe Grüsse
Stefan1

[snb]

Grundsetzlich so:

Code:

Sub M_snb()
   with getobject("G:\OF\beispiel.docx")
     for each it in .fields
       if instr(it.code,"author") then ....
     next
  end with
End Sub

[Stefan1]

Guten Tag snb
Das scheint sehr gut zu funktionieren :18: . Ich werde das morgen an der Original-Vorlage testen. Können Sie mir sagen, wie ich damit den Wert austauschen kann, falls das ginge und wie ich den Cursor für eine erweitere Texteingabe gleich einen Leerschlag daneben positionieren könnte.
Doch jetzt schon vielen Dank für den Hinweis.

Ich habe den Original-Code schon mal so präpariert und es geht (RF_Unterschrift1 anstelle Author):
           
            For Each cc In .Fields
                If InStr(cc.code, "RF_Unterschrift1") Then
                    MsgBox cc.code
                End If
            Next

[Stefan1]

Ich habe es heute getestet und es funktioniert, vielen Dank snb.
Wie könnte ich noch folgendes erreichen:

- Überschreiben dieser Autotextvorgabe
- Einen Leerschlag weiter eine Referenz-Nummer hinschreiben können

Vielen Dank für Eure Vorschläge.
Grüsse
Stefan1

[snb]

Code:

For Each it In .Fields
  If InStr(it.code, "RF_Unterschrift1") Then it.code="Neutext " & refnr
next

[Stefan1]

Code:

For Each it In .Fields
  If InStr(it.code, "RF_Unterschrift1") Then it.code="Neutext " & refnr
next

Guten Abend
In der Testanlage hat das gut funktioniert, doch leider nicht wo es sollte. Hier kommt bei it.code nun ein Laufzeitfehler '13', Typen unverträglich.
Jetzt bin ich wieder am Anfang. Leider kann ich die Vorlage nicht manipulieren.

Folgendes geht, aber nicht vollständig:

            For Each cc In .Fields
                If InStr(cc.Code, "test") Then
                    cc.Type = 19    'comments
                    cc.Result.Text = "Test Nr. 2"
                End If
            Next

Ich müsste also das AUTOTEXT-Feld in ein COMMENTS-Feld umwandeln können um den Text "Test Nr. 2" konstant behalten zu können. Doch da kommt auch eine Fehlermeldung bei cc.Type und zeigt an, dass Type geschützt ist. Also bleibt nur die Möglichkeit das Feld anzuspringen ohne zu verändern und zwei Leerschläge weiter nach rechts den Text einzufügen. Ist wenigstens das möglich?


Gruss und bitte um Hilfe
Stefan1

[Stefan1]

Guten Abend

Folgendes geht (aber etwas unschön mit Selection :22:)

Dim objAppWord As Object
Dim objWordDoc As Object
    Set objAppWord = GetObject(, "Word.Application")
    Set objWordDoc = objAppWord.Documents.Add(Template:="C:/Muster.dotx")
    With objWordDoc
            For Each cc In .Fields
                If InStr(cc.Code, "test") Then
                    s = cc.Result.Text: cc.Select
                    objAppWord.Selection.TypeText Text:=s & " Testtext-Zusatz")
                End If
            Next
    End With
    Set objWordDoc = Nothing

Vielen Dank für die Hilfe.
Grüsse und ein Gutes Neues Jahr wünscht
Stefan1