none
Como colocar hiperlink em imagem via Script VBS RRS feed

  • Pergunta

  • Bom dia,

    Gostaria de uma ajuda para colocar um hiperlink em uma imagem.

    Abaixo o arquivo VBS que utilizo atualmente 

    Const END_OF_STORY = 6
    Const wdFormatHTML = 8

    On Error Resume Next
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    With objUser
      strName = .FullName
      strTitle = .Description
    End With

    strCompany = objUser.Company
    strl = objUser.l
    strco = objUser.co
    strPhone = objUser.TelephoneNumber
    strFax = objUser.facsimileTelephoneNumber
    strMobile = objUser.Mobile
    strWeb = objuser.wWWHomePage
    strMail = objuser.mail
    strUserName = objuser.sAMAccountName
    strPager = objuser.Pager

    Set objword = CreateObject("Word.Application")
    With objword

      Set objDoc = .Documents.Add()
      Set objSelection = .Selection
      Set objEmailOptions = .EmailOptions
      
      Set objRange = objDoc.Range()
      objDoc.Tables.Add objRange,1,2
      Set objTable = objDoc.Tables(1)
     
    End With

    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

    With objSelection

    objTable.Rows.Add()
          
          objTable.Cell(2, 1).Range.InlineShapes.AddPicture "\\192.168.0.5\Programas\Procedimento\Assinaturas novas\primeira.png",true,True
          objTable.Columns(1).Width = objWord.InchesToPoints(1)

      objTable.Cell(2, 2).Select
         With .Font
        .Name = "Verdana"
        .Size = 9
        .Bold = True
        .Color = 0
         End With
        .TypeText strName & Chr(11)
        '.TypeParagraph()
         
      With .Font
        .Name = "Verdana"
        .Size = 7
        .Bold = False
        .Italic = False
        .Color = 0
      End With
        .TypeText strTitle & Chr(11) & "Email. " & strMail & chr(11) & "PABX. " & strPhone &  Chr(11) & "Cel. " & strMobile & Chr(11) & "Site. " & strWeb & Chr(11)
        '.TypeParagraph()
        '"Mobile. " & strFax & Chr(11) &    
        objSelection.EndKey END_OF_STORY   
        objSelection.Font.Name = "Verdana"
        objSelection.Font.Size = "7"
        objSelection.Font.italic = true
        objSelection.Font.Color = Black
        objSelection.Font.Bold = False
        '.TypeText Chr(11)
        objSelection.Font.italic = true
        objSelection.Font.Color = RGB(255,0,0)
        objSelection.Font.Bold = False
        'objSelection.TypeText "Estaremos em férias coletivas de 22 de Dezembro à 04 de Janeiro."
        '.TypeText Chr(11)
        'objSelection.TypeText "We will be closed from December 22th to January 4th."
        .TypeText Chr(11)
        .InlineShapes.AddPicture "\\192.168.0.5\Programas\Procedimento\Assinaturas novas\feiranac.png",true,True
        objSelection.Font.Color = Black
        .TypeText Chr(11)
        objSelection.TypeText "Esta mensagem e seus anexos são confidenciais e talvez privilegiados. Se você não é o destinatário, por favor notifique o remetente imediatamente e não divulgue o conteúdo para terceiros, tampouco use para outros propósitos ou armazene tais informações."
        .TypeText Chr(11)
        objSelection.Font.italic = true
        objSelection.Font.Color = 240240    
        objSelection.Font.Bold = False  
        objSelection.TypeText "* PENSE NA NATUREZA ANTES DE IMPRIMIR."
        .TypeText Chr(11)  
      End With

        
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Bralyx", objSelection
    objSignatureObject.NewMessageSignature = "Bralyx"
    objSignatureObject.ReplyMessageSignature = "Bralyx"
    objWord.ActiveDocument.Close(False)
          objWord.Quit()
           objWord = Nothing

    sexta-feira, 11 de dezembro de 2020 18:25

Todas as Respostas

  • Creio que seja isso que vc queira...

    veja se é isso...

    On Error Resume Next
    
    Const END_OF_STORY = 6
    Const wdFormatHTML = 8
    
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    With objUser
      strName = .FullName
      strTitle = .Description
    End With
    
    strCompany = objUser.Company
    strl = objUser.l
    strco = objUser.co
    strPhone = objUser.TelephoneNumber
    strFax = objUser.facsimileTelephoneNumber
    strMobile = objUser.Mobile
    strWeb = objuser.wWWHomePage
    strMail = objuser.mail
    strUserName = objuser.sAMAccountName
    strPager = objuser.Pager
    '*****************************************************************
    strPicture1 = "https://i1.social.s-msft.com/contentservice/a5019be8-e86c-476b-9fb9-a0e000d31145/Technet-logo.png"
    strPicture2 = "https://www.google.com/logos/doodles/2020/december-holidays-days-2-30-6753651837108830.3-law.gif"
    strLink1 = "https://social.technet.microsoft.com/Forums/pt-BR/home?forum=scriptadminpt"
    strLink2 = "www.google.com.br"
    '*****************************************************************
    Set objword = CreateObject("Word.Application")
    With objword
      Set objDoc = .Documents.Add()
      Set objSelection = .Selection
      Set objEmailOptions = .EmailOptions
    
      Set objRange = objDoc.Range()
      objDoc.Tables.Add objRange,1,2
      Set objTable = objDoc.Tables(1)
    End With
    
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    With objSelection
    	objTable.Rows.Add()
    	objTable.Cell(2, 1).Range.InlineShapes.AddPicture strPicture1,true,True
    	objDoc.Hyperlinks.Add objDoc.InlineShapes.Item(1), strLink1
    	objTable.Columns(1).Width = objWord.InchesToPoints(1)
    
    	objTable.Cell(2, 2).Select
    	With .Font
    		.Name = "Verdana"
    		.Size = 9
    		.Bold = True
    		.Color = 0
    	End With
        .TypeText strName & Chr(11)
        '.TypeParagraph()
    	With .Font
    		.Name = "Verdana"
    		.Size = 7
    		.Bold = False
    		.Italic = False
    		.Color = 0
    	End With
        .TypeText strTitle & Chr(11) & "Email. " & strMail & chr(11) & "PABX. " & strPhone &  Chr(11) & "Cel. " & strMobile & Chr(11) & "Site. " & strWeb & Chr(11)
        '.TypeParagraph()
        '"Mobile. " & strFax & Chr(11) &
        objSelection.EndKey END_OF_STORY
        objSelection.Font.Name = "Verdana"
        objSelection.Font.Size = "7"
        objSelection.Font.italic = true
        objSelection.Font.Color = Black
        objSelection.Font.Bold = False
        '.TypeText Chr(11)
        objSelection.Font.italic = true
        objSelection.Font.Color = RGB(255,0,0)
        objSelection.Font.Bold = False
        'objSelection.TypeText "Estaremos em férias coletivas de 22 de Dezembro à 04 de Janeiro."
        '.TypeText Chr(11)
        'objSelection.TypeText "We will be closed from December 22th to January 4th."
        .TypeText Chr(11)
        .InlineShapes.AddPicture strPicture2,true,True
    	objDoc.Hyperlinks.Add objDoc.InlineShapes.Item(2), strLink2
    
        objSelection.Font.Color = Black
        .TypeText Chr(11)
        objSelection.TypeText "Esta mensagem e seus anexos são confidenciais e talvez privilegiados. Se você não é o destinatário, por favor notifique o remetente imediatamente e não divulgue o conteúdo para terceiros, tampouco use para outros propósitos ou armazene tais informações."
        .TypeText Chr(11)
        objSelection.Font.italic = true
        objSelection.Font.Color = 240240
        objSelection.Font.Bold = False
        objSelection.TypeText "* PENSE NA NATUREZA ANTES DE IMPRIMIR."
        .TypeText Chr(11)
    End With
    
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Bralyx", objSelection
    objSignatureObject.NewMessageSignature = "Bralyx"
    objSignatureObject.ReplyMessageSignature = "Bralyx"
    objWord.ActiveDocument.Close(False)
    objWord.Quit()
    objWord = Nothing


    att, Aparecido Deveza

    • Sugerido como Resposta Aparecido Deveza quarta-feira, 30 de dezembro de 2020 13:41
    segunda-feira, 28 de dezembro de 2020 23:23