Notifications
Clear all

HIPERLINK VBA

2 Posts
2 Usuários
0 Reactions
1,073 Visualizações
(@barudi)
Posts: 0
New Member
Topic starter
 

Bom dia
Amigos preciso de uma ajuda.
Criei a macro abaixo, ela faz uma cópia de uma planilha(MATRIZ) dentro da própria pasta e renomeia a mesma para um nome que está em uma determinada célula da planilha
O que eu estou querendo agora é após criar a "nova planilha" criiar um hyper link automaticamente apontando para a "nova planilha" sem que o usuário tenha de fazê-lo manualmente.

sub cria_NOVA_PLAN_FORNECEDOR()
'
' cria_hiper Macro
'
Dim a
'
a = InputBox("INFORME NOVO FORNECEDOR")
ActiveSheet.Range("O1000").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = a
Sheets("MATRIZ").Select
    Sheets("MATRIZ").Copy Before:=Sheets(1)
    Sheets("MATRIZ (2)").Select
    Sheets("MATRIZ (2)").Name = a
    Range("E2").Value = a
Sheets("SETUP").Select
ActiveSheet.Range("O1000").End(xlUp).Offset(0, 0).Select
end sub

No exemplo anexo, estando na planilha MENU cliquem em RDT será direcionado para uma plan de nome SETUP nessa plan terão duas opções, uma é clicar sobre o hiperlink já existente ou clicar no símbolo "+" ao lado do título "Fornecedores" e então criar um novo fornecedor. Nessa última opção é que eu quero criar o hiperlink, ou seja o usuário clica no botao "+" após digiitar o nome do fornecedor além de criar a nova plan ainda faz o jiperlink para ela. Até a parte de criar a nova plan e retornar ao SSETUP está tudo funcionando, eu preciso agira criar o hiperlink automático. Tentei de várias formas e não consegui.
Peço sua ajuda
Muito obrigado

 
Postado : 19/07/2017 3:48 pm
(@osvaldomp)
Posts: 857
Prominent Member
 

Experimente:

Sub cria_NOVA_PLAN_FORNECEDOR()
 Dim a As String
  a = InputBox("INFORME NOVO FORNECEDOR")
  Application.ScreenUpdating = False
   Cells(Rows.Count, 15).End(3)(2) = a
   Sheets("MATRIZ").Copy Before:=Sheets(1)
   ActiveSheet.Name = a
   Range("E2").Value = a
   Sheets("SETUP").Hyperlinks.Add Anchor:=Sheets("SETUP").Cells(Rows.Count, 15).End(3), _
     Address:="", SubAddress:=a & "!A1", TextToDisplay:=a
   Sheets("setup").Activate
  Application.ScreenUpdating = True
End Sub
 
Postado : 19/07/2017 6:21 pm