Página 1 de 1

Criar Hiperlink de Guia Existentes e Novas

Enviado: 04 Dez 2020 às 16:36
por henriquerosa
Boa tarde

Gostaria de uma ajuda com a seguinte questão.

Tenho uma planilha com algumas abas já criadas (planilha de cadastro). Eu gostaria de criar uma aba principal com todos os nomes dos colaboradores com hiperlink para suas respectivas guias, e que ao ser criada nova guia seja adicionada automaticamente o nome e o hiperlink nessa guia principal. Existe alguma macro que atenda essa demanda?

Deixei um exemplo em anexo para ilustrar melhor.

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 04 Dez 2020 às 21:36
por osvaldomp
@
Instale um cópia do código abaixo em um módulo comum.
Código: Selecionar todos
Sub ListaPlansComHiperlink()
 Dim ws As Worksheet
  With Sheets("LISTA COM NOMES")
  [A2:A100] = ""
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "LISTA COM NOMES" Then
     .Cells(Rows.Count, 1).End(3)(2) = ws.Name
     .Hyperlinks.Add Anchor:=.Cells(Rows.Count, 1).End(3), Address:="", SubAddress:= _
            "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
   Next ws
  End With
End Sub
@
E instale uma cópia do código abaixo no módulo da planilha LISTA COM NOMES.
Código: Selecionar todos
Private Sub Worksheet_Activate()
 ListaPlansComHiperlink
End Sub

obs. antes de testar desfaça a desnecessária mesclagem de células em A1:A5

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 08 Dez 2020 às 10:06
por henriquerosa
osvaldomp, obrigado funcionou !

Após rodar o módulo surgiu mais uma dúvida que seria o seguinte, que se verificasse o texto de uma célula e a partir dessa condição acrescentar o nome da guia em determinada linha/coluna.
Deixei um exemplo anexado.

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 08 Dez 2020 às 10:35
por osvaldomp
Utilize o código abaixo no lugar do anterior.
Código: Selecionar todos
Sub ListaPlansComHiperlink()
 Dim ws As Worksheet
  With Sheets("LISTA COM NOMES")
  [A2:C100] = ""
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "LISTA COM NOMES" Then
     .Cells(Rows.Count, (Right(ws.[D3], 1) * 1)).End(3)(2) = ws.Name
     .Hyperlinks.Add Anchor:=.Cells(Rows.Count, (Right(ws.[D3], 1) * 1)).End(3), Address:="", SubAddress:= _
            "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
   Next ws
  End With
End Sub

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 08 Dez 2020 às 22:28
por henriquerosa
Osvaldo boa noite,

No código ele utiliza os números da célula D3 como base organizadora (right,1). É possível ser uma String Right 6 dígitos?

Procurei como fazer para que eu mesmo modificasse o código porém não achei. Já agradeço a ajuda e peço desculpas, comecei a utilizar VBA recentemente.

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 08 Dez 2020 às 22:48
por osvaldomp
Olá, Henrique.

Na planilha de exemplo você colocou em D3: Sala 1, Sala 2 ou Sala 3.

Qual será exatamente o conteúdo de D3 nas planilhas originais ? Será algo como Sala 000000 ?

E na planilha LISTA COM NOMES quantas colunas haverá para receber os nomes das planilhas ?

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 09 Dez 2020 às 00:33
por henriquerosa
Osvaldo,

no exemplo utilizei sala 1,2 e 3 mas não me atentei que eles poderiam ser usados como base.

célula D3 com as seguintes opções SALA NOTURNA, SALA DIURNA, SALA 1, SALA 2, SALA INTERMEDIÁRIA com 5 colunas (pra cada opção uma coluna) iniciando na A5 LISTA COM NOMES

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 09 Dez 2020 às 10:01
por osvaldomp
Olá, Henrique.

Experimente o código abaixo no lugar do anterior.
Código: Selecionar todos
Sub ListaPlansComHiperlinkV2()
 Dim ws As Worksheet, i As Long
  With Sheets("LISTA COM NOMES")
  [A6:E100] = ""
   For Each ws In ThisWorkbook.Worksheets
    On Error GoTo nxt
    If ws.Name <> "LISTA COM NOMES" And ws.[D3] <> "" Then
     i = Application.Match(ws.[D3], Array("Sala NOTURNA", "SALA DIURNA", "SALA 1", "SALA 2", "SALA INTERMEDIÁRIA"), 0)
     .Cells(Rows.Count, i).End(3)(2) = ws.Name
     .Hyperlinks.Add Anchor:=.Cells(Rows.Count, i).End(3), Address:="", SubAddress:= _
            "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
nxt:
   Next ws
  End With
End Sub
obs.
1. considerei que na planilha LISTA COM NOMES os títulos de colunas estarão em A5:E5 e na ordem que você colocou no seu post acima, no entanto, se estiverem em A4:E4, então altere no código de [A6:E100] = "" ~~~> para ~~~> [A5:E100] = ""
2. se D3 estiver vazia ou com conteúdo não existente na lista de opções então o nome da planilha não será lançado

Como bônus segue abaixo um código para ativar a planilha LISTA COM NOMES. Para rodar esse código eu sugiro que você o vincule a um atalho de teclado, para acessar aperte Alt+F8, assim, a partir de qualquer planilha você poderá ativá-la facilmente, pois me pareceu que o seu arquivo original tem grande quantidade de planilhas.
Código: Selecionar todos
Sub AtivaListaComNomes()
 Sheets("LISTA COM NOMES").Activate
End Sub

Re: Criar Hiperlink de Guia Existentes e Novas

Enviado: 10 Dez 2020 às 16:20
por henriquerosa
Osvaldo, Boa tarde

Funcionou perfeitamente, obrigado pela ajuda e paciência! Abraço