Word VBscript-删除表中和表后的额外行

我有一个Word vbscript，用于设置公司签名。我试图找出如何在表之前添加行，并删除表之后显示的额外行

代码如下：

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

（出于安全原因，我删除了第一列中的徽标/图像），但出于某些原因，在表格中的文本和徽标（如果有）下方有额外的行，并且表格下方也有额外的行。如果可能的话，我需要那些消失？任何帮助都将不胜感激！：）

---

谢谢

要在表格之前添加行，最好在插入表格之前添加行（我假设是段落）。比如：

objRange.Text = Chr(13) & Chr(13)
objRange.Collapse 0 'end
Set objTable = objDoc.Tables.Add(objRange, NUMBER_OF_ROWS, NUMBER_OF_COLUMNS)

---

我没有看到任何图片，但您的问题描述表明应该有一个图片来说明问题？关于“文本和徽标下方的额外线条…以及表格下方”的部分不清楚。表格下面总是有一个空段落——Word出于结构上的原因需要它，而你无法摆脱它。但是我没有看到表外的代码，所以我们需要更多关于这一点的信息。把这个问题单独提出来可能会更好，因为它与我已经回答的另一个问题无关。很抱歉给你带来了困惑。我的意思是——如果你看一下桌子上的边框，它似乎比文本下面的一行还多。是否可以将其设置为文本正下方？我正试图在文本和表格下面尽可能多地释放空间。这在很大程度上取决于整个表格行的内容，我们现在不可能知道。您是否熟悉Word的非打印字符视图-主页/段落中的“向后P”按钮？启用该选项后，您可以查看单元格中可能包含的字符类型。还有单元格填充（边距）-您可以在表属性/表（和单元格）/选项中进行检查。您要确保为所有单元格设置了-rngCell.ParagraphFormat.SpaceAfter=0，而不仅仅是一个单元格。我只是想让表的底部与行中文本的底部相衔接。目前，它似乎是文本下方的额外一行。我将表格中的签名复制到Word中，通过更改行高，我可以使行与底部齐平：正好是-0.5“。然而，我试图用vbscript实现这一点，使用了不同的RowHeight、SetHeight等变体，但我似乎无法坚持下去。有什么建议吗？：）没有关系。找出我做错了什么。我没有在第一列中显示徽标，因此它不会随桌子向下移动。