Text in einem Textfeld mit Tabelle fett per Makro ausgeben

[karly]

Hallo alle zusammen,

ich hoffe, ich bekomme hier schnelle Hilfe für mein Problem.

Ich füge per Makro in ein Dokument ein Textfeld ein, in dieses eine Tabelle und dahinein einen Text, z.B. "Dringend". Nachdem dies alles durchgeführt wurde, möchte ich den Text fett formatiert haben.

Ich habe dies schon mit mehreren Makros versucht, leider klappt das nicht mit der Formatierung, der Rest schon. Im Software-Forum habe ich schon ein ähnliches Thema mit einem Makrovorschlag gefunden. Leider funktioniert das bei mir nicht.

Einen Auszug des Codes nachstehend.

Ich muss allerdings anmerken, dass ich nicht viel Ahnung von VBA habe und die ganze Sache mehr im Sinne von "Learning by doing" gemacht habe.

Trotzdem schon mal vielen Dank für eine mögliche Hilfe

Karly

Sub mkPersBox(cellcount, strbox() As String)

Dim oShape As Shape, oTable As Table, oCell As Cell

breite = 11.5

hoehe = 0.9

AbstandRechts = 7.3

AbstandUnten = 25

With ActiveDocument.Sections(1).PageSetup

x = .PageWidth - CentimetersToPoints(breite + AbstandRechts)

y = .PageHeight - CentimetersToPoints(hoehe + AbstandUnten)

End With

Set oShape = _

ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _

Left:=x, _

Top:=y, _

Width:=CentimetersToPoints(breite), _

Height:=CentimetersToPoints(hoehe))

oShape.Line.Visible = False 'Rahmen ausblenden

oShape.Fill.Visible = False 'Keine Füllung

Set oTable = ActiveDocument.Tables.Add(Range:=oShape.TextFrame.TextRange, _

NumRows:=cellcount, NumColumns:=1)

oTable.Borders.OutsideLineStyle = False

oTable.Borders.OutsideLineWidth = False

oTable.Borders.InsideLineStyle = False

i = 0

For Each oCell In oTable.Range.Cells

i = i + 1

oCell.Range.Text = "- " & strbox(i)

Next

End Sub

'Ausgabe für Personalsache fett formatieren

Sub Text_formatieren()

Selection.Find.ClearFormatting

With Selection.Find

.Text = "- V e r t r a u l i c h e P e r s o n a l s a c h e -"

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute

With Selection.Font

.Name = "Arial"

.Size = 11

.Bold = True

End With

End Sub