我只是想让表格的底部“拥抱”行中文本的底部。目前,它似乎是文本下面的额外行。我将表格中的签名复制到Word中,我可以通过更改行高度来获得与底部齐平的行:正好 - 0.5“。但是,我尝试使用vbscript使用各种变体来完成此操作RowHeight,SetHeight等我似乎无法坚持下去。这是我的最后一步!有什么建议吗?:)
这是我的代码:
Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strFirst = objUser.FirstName
strLast = objUser.LastName
strInitials = objUser.Initials
strOffice = objUser.physicalDeliveryOfficeName
strPOBox = objUser.postOfficeBox
strTitle = objUser.Description
strCred = objUser.info
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail
strCompany = objUser.Company
Set objWord = CreateObject("Word.Application")
Const END_OF_STORY = 6
Const NUMBER_OF_ROWS = 1
Const NUMBER_OF_COLUMNS = 2
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, NUMBER_OF_ROWS, NUMBER_OF_COLUMNS
Set objTable = objDoc.Tables(1)
Dim rngCell
Set rngCell = objTable.Cell(1, 2).Range
objTable.Columns(1).Width = 50
objTable.Columns(2).Width = 360
rngCell.ParagraphFormat.SpaceAfter = 0
rngCell.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
rngCell.ParagraphFormat.LineSpacing = 12
rngCell.Text = strFirst & " " & strInitials & " " & strLast & " | " & _
strOffice & " | " & strCompany & vbCr
rngCell.Font.Bold = True
rngCell.Font.Name = "Calibri"
rngCell.Font.Size = 10
rngCell.Collapse 0 'wdCollapseEnd
rngCell.MoveEnd 1, -1 'wdCharacter, 1
rngCell.Text = strStreet & " | " & strPOBox & " | " & strLocation & vbCr
rngCell.Font.Bold = False
rngCell.Font.Name = "Calibri"
rngCell.Font.Size = 10
rngCell.Collapse 0 'wdCollapseEnd
rngCell.MoveEnd 1, -1 'wdCharacter, 1
rngCell.Text = vbCr & "Phone: " & strPhone & " | " & "Fax: " & strFax & " | " & "Email: " & vbCr
rngCell.Font.Bold = False
rngCell.Font.Name = "Calibri"
rngCell.Font.Size = 10
rngCell.Collapse 0 'wdCollapseEnd
rngCell.MoveEnd 1, -1 'wdCharacter, 1
Set objLink = objTable.Cell(1, 2).Range
objLink.Hyperlinks.Add rngCell, "mailto:" & strEmail,,,strEmail
objLink.Font.Size = 10
objLink.Font.Name = "Calibri"
objSelection.EndKey END_OF_STORY
objSelection.ParagraphFormat.SpaceAfter = 0
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Reply Signature", objSelection
objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = True
objWord.Quit
答案 0 :(得分:0)
录制宏给了我HeightRule和Height作为设置表格行高度的关键属性。从您的问题描述中,您似乎错过了HeightRule
,需要将其设置为wdRowHeightExactly
(对于VBScript,Enum整数等效值为2)。例如:
Dim rw as Word.Row
Set rw = objTable.Rows(1)
rw.HeightRule = 2 'wdRowHeightExactly
rw.Height = 72 'InchesToPoints(1)
答案 1 :(得分:0)
无助的我解决了我遇到的问题:
objSelection.EndKey END_OF_STORY
objSelection.ParagraphFormat.Alignment = 0
objSelection.ParagraphFormat.SpaceAfter = 0
objSelection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
objSelection.ParagraphFormat.LineSpacing = 1
objSelection.Font.Size = 1