Hallo zusammen,

ich möchte per Makro folgendes erreichen

- Altes Textfeld markieren und löschen
- Anschließend neues Textfeld schreiben

Dabei sollen folgende Inhalte in dieses Textfeld
hr Ansprechpartner:
<Mitarbeiter>
Telefon:<Tab> <MitarbeiterTelefonnr>
Telefax:<Tab> <MitarbeiterFaxnr>
E-Mail:<Tab> <MitarbeiterEMail>

Kunden-Nummer:<Tab> <Kundennr>
Vertragskonto-Nummer:<Tab> <Vertragskonto>


<aktuelles Datum>

<...> = Name des Formularfeldes
<Tab> = Drücken der Tab-Taste bzw. das entsprechende Zeichen

Aussehen soll das ganze dann so:
hr Ansprechpartner:
xxxxxxx
Telefon: xxxxxxx
Telefax: xxxxxxx
E-Mail: xxxxxxxx

Kunden-Nummer: xxxxxxx
Vertragskonto-Nummer: xxxxxxx


18. Januar 2012

Es müssen zwei Tabulartorpositionen gesetzt werden:
- für Telefon bis E-Mail
- für Kunden- und Vertragskonto

Dei Schriftart soll Times New Roman 10 und für Datum 12 sein

Mein bisheriger Code
Sub Textfeld_Zeichnen()
Dim shp As Word.Shape

ActiveDocument.Shapes(1).Delete
Set shp = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=10, _
Top:=10, _
Width:=10, _
Height:=10, _
Anchor:=Selection.Paragraphs(1).Range)

With shp
.Name = "TB_" & CStr(Rnd())
.LockAnchor = True

.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage

.LockAspectRatio = False
.Top = CentimetersToPoints(5)
.Left = CentimetersToPoints(12.5)
.Width = CentimetersToPoints(6.5)
.Height = CentimetersToPoints(5.5)

.Line.ForeColor.RGB = RGB(255, 255, 255)
.Line.BackColor.RGB = RGB(255, 255, 255)
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 10

.TextFrame.TextRange.Text = "Ihr Ansprechpartner:" & vbCrLf & _
"" & vbCrLf & _
"Telefon:" & vbTab & vbCrLf & _
"Telefax:" & vbTab & vbCrLf & _
"E-Mail:" & vbTab & vbCrLf & vbCrLf & _
"Kunden-Nummer:" & vbTab & vbCrLf & _
"Vertragskonto-Nummer:" & vbTab & vbCrLf & vbCrLf

'.TextFrame.TextRange.FormFields.Add(.TextFrame.TextRange.FormFields.Add(,wdFieldFormTextInput)
' .TextFrame.TextRange.InlineShapes.AddOLEControl ("Forms.TextBox.1")
'.TextFrame.TextRange.Text = .TextFrame.TextRange.Text & Formularfeld_Einfügen_Text("Mitarbeiter")
End With
End sub

Was mir noch fehlt.

- Das setzen der Schriftart und Größe für das Datum
- Die entsprechenden Formularfelder

Welche Formularfelder ich meine
- bis Word 2003 die, die man über die Symbolleiste 'Formular, AB|" einfügen konnte
- Word 2010 die, die man über Ribbon 'Entwicklertools, Steuerelemente, Vorversionstools, Erste Symbol ab|'
bekommt. Diese sind dann graue Felder
- Die einzelnen Felder benennen (siehe Spitzeklammern oben)

Das ganze soll für Briefe sein, die alle darüber ein entsprechendes Textfeld bekommen sollen. Die Benennung der Formularfelder soll dafür sein, dass ein anderes Makro die entsprechenden Benutzerwerte einfügt (klappt schon). Ich als Betreuer der Vorlagen will mir dadurch das Einrichten bestehender Vorlagen vereinfachen und die Vorlagen immer gleich aussehen. Weiterhin sollen die Benutzer Ihre eigenen Vorlagen dadurch auch schnell umändern konnen.

So, Ich hoffe, dass ihr mich versteht und freue mich, wenn mir jemand von Euch einen entsprechenden Bsp.-Code geben kann.

Vielen Dank
Volker Bunge

Hallo zusammen,

da mir bis jetzt keiner helfen konnte, habe ich mich mit folgender Zwischenlösung beholfen.

Den entsprechenden Bereich erstellt und ihn dann als Autotext abgespeichert.

Mein Makro fügt nun diesen Autotext an der gewünschten Stelle ein.

Sub Es_schreibt_Ihnen_Rahmen_zeichnen()

Dim shp As Word.Shape
Dim ffield As FormField
Dim aEntry As AutoTextEntry

' Aktualisierungsanzeige ausschalten
Application.ScreenUpdating = False

Call Schreibschutz_Ein_Aus("False")

' Den Startpunkt (Anfang des Dokumentes) festlegen
Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes

' Alter Rahmen vorher löschen
Call Grafiken_Löschen("Es_Schreibt_Ihnen")

' Den Startpunkt (Anfang des Dokumentes) festlegen
Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes

' Autotext Es_Schreibt_Ihnen einfügen
For Each aEntry In Templates("Pfad incl. Dateiname, in der der Autotext enthalten ist").AutoTextEntries
If aEntry.Name = "Es_Schreibt_Ihnen" Then
aEntry.Insert Where:=Selection.Range, RichText:=True
End If
Next aEntry

' Den Startpunkt (Anfang des Dokumentes) festlegen
Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes

' Werte einfügen
Call Werte_Einfügen ' Die Funktion, die mir die Formularfelder mit Werte füllt. Hier nicht dabei

' Schreibschutz wieder einschalten
Call Schreibschutz_Ein_Aus("True")

' Aktualisierungsanzeige wieder einschalten
Application.ScreenUpdating = True

End Sub
Sub Schreibschutz_Ein_Aus(Optional Status As String = "Umschalten")

Select Case Status

Case "False"
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect
Geschützt = 1
End If
Case "True"
If ActiveDocument.Bookmarks.Exists("NichtSchützen") = False Then
Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes
If ActiveDocument.ProtectionType <> 2 Then
ActiveDocument.Protect wdAllowOnlyFormFields, True
End If
End If
Case "Umschalten"
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect
Geschützt = 1
Else
If ActiveDocument.Bookmarks.Exists("NichtSchützen") = False Then
Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes
ActiveDocument.Protect wdAllowOnlyFormFields, True
End If
End If
End Select
End Sub
Function Grafiken_Löschen(Welche As String)
Select Case Welche
Case "Es_Schreibt_Ihnen"
On Error Resume Next
For z = 1 To ActiveDocument.Shapes.Count
If InStr(1, ActiveDocument.Shapes(z).Name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).Name, "Unterschrift") > 0 Then
Else
ActiveDocument.Shapes(z).Select
ActiveDocument.Shapes(z).Delete
End If
Next z
For z = 1 To ActiveDocument.Frames.Count
ActiveDocument.Frames(z).Select ' Frame markieren
ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
Selection.Delete Unit:=wdCharacter, Count:=1 ' daher Inhalt des Frames auch löschen
Next z
On Error GoTo 0
Case "Logo"
On Error Resume Next
For z = 1 To ActiveDocument.Shapes.Count
' MsgBox z & " " & ActiveDocument.Shapes(z).Name
If InStr(1, ActiveDocument.Shapes(z).Name, "Logo") > 0 Then
ActiveDocument.Shapes(z).Select
ActiveDocument.Shapes(z).Delete
End If
Next z
On Error GoTo 0
Case "Unterschrift"
On Error Resume Next
For z = 1 To ActiveDocument.Shapes.Count
If InStr(1, ActiveDocument.Shapes(z).Name, "Unterschrift") > 0 Then
ActiveDocument.Shapes(z).Select
ActiveDocument.Shapes(z).Delete
End If
Next z
On Error GoTo 0
End Select
End Function