Question

我正在寻求建议/协助我的帖子，我已经从网上提示，并分阶段处理我最后一个没有成功的问题。

第4 - 8行的所有信息都会在我的徽标旁边的第3行下方向上移动。现在由于徽标行高，导致第4 - 8行下降到徽标的行下方。我一直试图拆分/合并列没有成功。请看下面的图片。

以下是我一直在混搭的代码：

    On Error goto 0 

Const END_OF_STORY = 6  

Set objSysInfo = CreateObject("ADSystemInfo")   

' ########### This section connects to Active Directory as the currently logged on user 

strUser = objSysInfo.UserName   

Set objUser = GetObject("LDAP://" & strUser)    

sLogoLocation = "\\servername\pic\Sig\logo.jpg" 
sStripeLocation = "\\servername\pic\Sig\candystripe.gif"    

sLinkAddress = "http://www.yourwebsite.com" 
sDisplayLinkText = "www.yourwebsite.com"    
sBoldSloganText = "BOLD TEXT USED FOR SLOGAN"   
sNormalSloganText = "NORMAL TEXT USED FOR SLOGAN"   

' ########### This section sets up the variables we want to call in the script (items on the left; whereas the items on the right are the active directory database field names) - ie strVariablename = objuser.ad.databasename 

strGiven = objuser.givenName    
strSurname = objuser.sn 
strAddress1 = objUser.streetaddress 
strAddress1EXT = objUser.postofficebox  
strAddress2 = objuser.l 
strAddress3 = objuser.st    
strPostcode = objuser.postalcode    
strCountry = objuser.c  
strFax = objuser.facsimileTelephoneNumber   
strMobile = objuser.mobile  
strTitle = objUser.Title    
strDepartment = objUser.Department  
strCompany = objUser.Company    
strPhone = objUser.telephoneNumber  
strEmail = objuser.mail 
strWeb = objuser.wWWHomePage    
strNotes = objuser.info 
strExt = objuser.ipPhone    
strDDI = objuser.homephone  
strEmailTEXT = "Email: "    
strOffice = objuser.physicalDeliveryOfficeName  
strPOBOx = objuser.PostOfficeBox    


' ########### Sets up word template 

Set objWord = CreateObject("Word.Application")  
Set objDoc = objWord.Documents.Add()    
Set objSelection = objWord.Selection    
objSelection.Style = "No Spacing"   
Set objEmailOptions = objWord.EmailOptions  
Set objSignatureObject = objEmailOptions.EmailSignature 
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries  

' ########### Separate main logo from other tables in the script in its own singular column.    


' ########### Calls the variables from above section and inserts into word template, also sets initial font typeface, colour etc.   

on error resume next    

Const wdAlignParagraphRight = 2 
Const NUMBER_OF_ROWS = 8    
Const NUMBER_OF_COLUMNS = 3 

Set objRange = objDoc.Range()   

objDoc.Tables.Add objRange, NUMBER_OF_ROWS, NUMBER_OF_COLUMNS   

Set objTable = objDoc.Tables(1) 
objTable.Cell(1, 1).Width = "3" 
objTable.Cell(2, 1).Width = "3" 
objTable.Cell(1, 2).Width = "15"    
objTable.Cell(2, 2).Width = "15"    
objTable.Rows(1).Range.Font.Bold = true 
'objTable.Cell(1, 1).Range.Text = ""    
objTable.Cell(1, 2).Range.Text = objuser.givenName & " " & objuser.sn & "  |  " & objuser.Title & "  |  " & objuser.Department  
objTable.Cell(2, 2).Range.InlineShapes.AddPicture(sStripeLocation)  
objTable.Cell(3, 1).Width = "3" 
objTable.Cell(3, 2).Width = "15"    
objTable.Cell(4, 1).Width = "3" 
objTable.Cell(4, 2).Width = "10"    
objTable.Cell(4, 3).Width = "10"    
objTable.Cell(5, 1).Width = "3" 
objTable.Cell(5, 2).Width = "15"    
objTable.Cell(6, 1).Width = "3" 
objTable.Cell(7, 1).Width = "3" 
objTable.Cell(8, 1).Width = "3" 
objTable.Rows(3).Range.Font.Bold = false    
objTable.Rows(4).Range.Font.Bold = false    
objTable.Rows(5).Range.Font.Bold = false    
objTable.Rows(6).Range.Font.Bold = false    
'objTable.Rows(3).Cells(1).Split 1, 5   
'objTable.Rows(3).Cells(3).Split 1, 2   
objTable.Cell(5, 2).Merge objTable.Cell(5, 8)   
objTable.Cell(3, 2).Merge objTable.Cell(3, 6)   
objTable.Cell(4, 2).Merge objTable.Cell(4, 6)   
objTable.Cell(6, 2).Merge objTable.Cell(6, 6)   
objTable.Cell(3, 1).Range.InlineShapes.AddPicture(sLogoLocation)    
objTable.Cell(3, 2).Range.Text = "SwitchBoard:  " & objuser.TelephoneNumber & " | " & "Extension:  " & objuser.physicalDeliveryOfficeName   
objTable.Cell(4, 2).Range.Text = "Fax Number:  " & objuser.facsimileTelephoneNumber & " | " & "Mobile:  " & objuser.Mobile  
objTable.Cell(5, 2).Range.Text = "Address:  " & objUser.streetaddress & ", " & objuser.l & ", " & objuser.postalcode & ", " & objuser.st & ", " & objuser.c 
objTable.Cell(6, 2).Range.Text = "P.O Box:  " & objuser.PostOfficeBox   

Set objCell = objTable.Cell(7, 2)   
Set objCellRange = objCell.Range    
objCell.Select  
objSelection.TypeText "Website: "   
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "http://www.mycompany.com", , , "www.mycompany.com")  

Set objCell = objTable.Cell(8, 2)   
Set objCellRange = objCell.Range    
objCell.Select  
objSelection.TypeText "E-mail: "    
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail)  

 objLink.Range.Font.Name = "Verdana"    
   objLink.Range.Font.Size = 8  
   objLink.Range.Font.Bold = false  
   objSelection.Font.Color = RGB (000,045,154)  

objSelection.EndKey END_OF_STORY    

objSelection.TypeParagraph()    

' ####### Used Exchange 2007 for the disclaimer text to ensure all email is covered (this script forces the user to use this as the default signature, it does not however prevent them from selecting another one when writing an email. Would recommend taking a similar approach to cover yourselves.    

' ########### Tells outlook to use this signature for new messages and replys. Signature is called Email Signature. 

Set objSelection = objDoc.Range()   

objSignatureEntries.Add "Email Signature", objSelection 
objSignatureObject.NewMessageSignature = "Email Signature"  
'objSignatureObject.ReplyMessageSignature = "Email Signature"   

objDoc.Saved = True 

objWord.Quit

需要企业签名vbs脚本协助

0 个答案: