Dynamische Tabelle in VBS - Signatur

Hallo!
Aktuell sitze ich an einem Signaturskript, was mit Daten aus dem AD gefüttert wird. So ist aktuell die Ausgabe:

Folgendes Problem:
Die Spalten werden anhand vom längsten Wert festgelegt und somit ist bei vielen Zeilen zu viel Platz. Daten aus dem AD werden richtig angezeigt. Ursprünglich hatte ich alle Zeilen verbunden, nun bin ich aber beim Ansatz in jede einzelne Zeile einen Wert einzutragen und diese dann im Idealfall dynamisch anzupassen. Ist das überhaupt möglich? Ich hatte Lösungen mit "objTable.AutoFitBehavior(1) " gesehen und in verschiedenen Ausführungen getestet, aber getan hat sich da nichts.

Skript:

Set objWord = CreateObject("Word.Application")  
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
set objRange = objDoc.Range()


objDoc.Tables.Add objRange,6,6
Set objTable = objDoc.Tables(1)

objDoc.Styles("Hyperlink").Font.Color = RGB(255, 128, 0)  
objSelection.ParagraphFormat.LineSpacing = 10
objdoc.Paragraphs.SpaceAfter = 0
objTable.Cell(1,1).Merge objTable.Cell(2,1) 
objTable.Cell(1,1).Merge objTable.Cell(3,1) 
objTable.Cell(1,1).Merge objTable.Cell(4,1) 
objTable.Cell(1,1).Merge objTable.Cell(5,1) 
objTable.Cell(1,1).Merge objTable.Cell(6,1) 

'objtable.cell(1,1).width = 95  

objTable.Cell(1,5).Merge objTable.Cell(1,6) 
objTable.Cell(1,4).Merge objTable.Cell(1,5) 
objTable.Cell(1,3).Merge objTable.Cell(1,4) 
objTable.Cell(1,2).Merge objTable.Cell(1,3)

'objTable.Cell(2,5).Merge objTable.Cell(2,6)    
'objTable.Cell(2,4).Merge objTable.Cell(2,5)    
'objTable.Cell(2,3).Merge objTable.Cell(2,4)   
'objTable.Cell(2,2).Merge objTable.Cell(2,3)  

'objTable.Cell(3,4).Merge objTable.Cell(3,5)   
'objTable.Cell(3,3).Merge objTable.Cell(3,4)   
'objTable.Cell(3,2).Merge objTable.Cell(3,3)  
'objTable.Cell(4,4).Merge objTable.Cell(4,5)   
'objTable.Cell(4,3).Merge objTable.Cell(4,4)   
'objTable.Cell(4,2).Merge objTable.Cell(4,3)  
'objTable.Cell(5,4).Merge objTable.Cell(5,5)   
'objTable.Cell(5,3).Merge objTable.Cell(5,4)   
'objTable.Cell(5,2).Merge objTable.Cell(5,3)  
'objTable.Cell(6,4).Merge objTable.Cell(6,5)   
'objTable.Cell(6,3).Merge objTable.Cell(6,4)   
'objTable.Cell(6,2).Merge objTable.Cell(6,3)  

objTable.Cell(1,1).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
objTable.Cell(1,1).Range.InlineShapes.AddPicture(strLogo)

objTable.Cell(1,2).Range.Font.Size = "12"  
objTable.Cell(1,2).Range.Font.Bold = True
objTable.Cell(1,2).Range.Text = "Firma"  

Set objCell = objTable.Cell(2,2)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(2,2).Range.Font.Bold = True
objTable.Cell(2,2).Range.Font.Size = "11"  
objSelection.TypeText strName 

Set objCell = objTable.Cell(2,3)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(2,3).Range.Font.Bold = False
objTable.Cell(2,3).Range.Font.Size = "11"  
objTable.Cell(2,3).Range.Text = "|" & strTitle  

Set objCell = objTable.Cell(4,2)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(4,2).Range.Font.Bold = False
objTable.Cell(4,2).Range.Text =  strStreet 

Set objCell = objTable.Cell(4,3)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(4,3).Range.Font.Bold = False
objTable.Cell(4,3).Range.Text =  strPostCode 

Set objCell = objTable.Cell(4,4)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(4,4).Range.Font.Bold = False
objTable.Cell(4,4).Range.Text =   strLocation

Set objCell = objTable.Cell(5, 2)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(5,2).Range.Font.Bold = True
objSelection.TypeText  "T: "  

Set objCell = objTable.Cell(5, 3)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(5,3).Range.Font.Bold = False
objSelection.TypeText   strPhone

Set objCell = objTable.Cell(5, 4)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(5,4).Range.Font.Bold = True
objSelection.TypeText  "| M: "   

Set objCell = objTable.Cell(5, 5)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(5,5).Range.Font.Bold = False
objSelection.TypeText strMobile

Set objCell = objTable.Cell(6,2)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(6,2).Range.Font.Bold = True
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, strEmail,,strEmail,strEmail)

Set objCell = objTable.Cell(6,3)
Set objCellRange = objCell.Range
objCell.Select
objTable.Cell(6,3).Range.Font.Bold = True
objSelection.TypeText " | "  
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range,"http://" & strCompanyWeb,,strCompanyWeb,strCompanyWeb)  

objTable.AutoFitBehavior(1) 


Set objSelection = objDoc.Range()
objSignatureEntries.Add "Design", objSelection  
objSignatureObject.NewMessageSignature = "Design"  
objDoc.Saved = True
objWord.Quit

Hat jemand noch weitere Ideen oder einen komplett anderen Ansatz?
Danke!

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 644672

Url: https://administrator.de/forum/dynamische-tabelle-in-vbs-signatur-644672.html

Ausgedruckt am: 25.05.2025 um 02:05 Uhr

1 Kommentar

Mahlzeit!

Wie wäre folgendes?

Du bereitest 3 Vorlagen vor als html, rtf und txt.
Diese baust Du layoutmäßig, wie Du sie brauchst und benutzt auffindbare Platzhalter.

Dann schreibst Du ein passendes Script, das lediglich die Platzhalter mit den Nutzerdaten ersetzt und die drei Signaturen in den Outlook-Ordner platziert.

So hab ich das bisher gemacht.

Das Problem mit "komplizierten" Signaturen ist für mich immer das gleiche:
Nur unter bestimmten Bedingungen sehen sie recht gut aus, ansonsten zerschießen sie sich.

Ich empfehle: So einfach wie möglich, so kompliziert wie nötig.

Dann sollte nix schiefgehen.

Frage VB for Applications Entwicklung

Heiß diskutiert