Word vbscript行高问题

时间:2016-02-03 20:43:39

标签: vbscript ms-word

我只是想让表格的底部“拥抱”行中文本的底部。目前,它似乎是文本下面的额外行。我将表格中的签名复制到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

2 个答案:

答案 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