Pessoal Bom dia,
Peço que me ajudem por favor. O meu problema é o seguinte:
Tenho este código ->
On Error Resume Next
Const END_OF_STORY = 6
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
With objUser
strName = "Israel de Oliveira Alcântara"
strSetor = "Gerência Tecnologia da Informação"
strCargo = "Analista de Sistemas Jr"
strPhone = "(092) 3627-5114"
strMobile = ""
End With
Set objword = CreateObject("Word.Application")
With objword
Set objDoc = .Documents.Add()
Set objSelection = .Selection
Set objEmailOptions = .EmailOptions
End With
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
With objSelection
.ParagraphFormat.Alignment = wdAlignParagraphRight
.TypeParagraph()
'----------------------------------------------
'Criando tabela
Set objRange = objSelection.Range
objDoc.Tables.Add objRange, 1, 6
Set objTable = objDoc.Tables(1)
objTable.AutoFitBehavior(1)
'----------------------------------------------
'Sets up the first cell with the logo inside
Set objCell = objTable.Cell(1, 1)
'Set objCellRange = objCell.Range
'objSelection.Range = objCell.Range
objCell.Select
'objSelection.InlineShapes.AddPicture(strLogoPath)
objSelection.InlineShapes.AddPicture "C:\Users\6548367\Desktop\AssinaturaAngela\Logo.png", True, True
objTable.Cell(1, 2).Range.InlineShapes.AddPicture "C:\Users\6548367\Desktop\AssinaturaAngela\barrav.png",true,True
'Sets up the second cell
Set objCell = objTable.Cell(1, 3)
'Set objCellRange = objCell.Range
objCell.Select
'---------------------------------------------------------
'Configurar o nome de usuario e o setor
'---------------------------------------------------------
With .Font
.Name = "Verdana"
.Size = 9
.Bold = true
.Italic = false
objSelection.Font.Color = RGB(0,115,170)
End With
.TypeText strName & Chr(11)
With .Font
.Size = 8
.Bold = False
End With
.TypeText strCargo & Chr(11)
.TypeText strSetor & Chr(11)
.TypeText "Fone: " & strPhone
If strMobile <> "" Then
.TypeText " / " & strMobile
End If
.TypeText Chr(11)
.TypeText "www.manausambiental.com.br"
objTable.Cell(1, 4).Range.InlineShapes.AddPicture "C:\Users\6548367\Desktop\AssinaturaAngela\branco.png",true,True
'Sets up the third cell with the logo inside
Set objCell = objTable.Cell(1, 5)
'Set objCellRange = objCell.Range
'objSelection.Range = objCell.Range
objCell.Select
objTable.Cell(1, 5).Range.InlineShapes.AddPicture "C:\Users\6548367\Desktop\AssinaturaAngela\marca3.png",true,True
objTable.Cell(1, 6).Range.InlineShapes.AddPicture "C:\Users\6548367\Desktop\AssinaturaAngela\teste.png",true,True
objSelection.EndKey END_OF_STORY
End With
Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objword.Quit
que gera a assinatura que esta anexada como imagem1
A unica coisa que quero poder alterar é o texto em azul. para que fique como está na imagem2 anexada
me ajudem pessoal... por favor .. só falta finalizar isso
