Ir ao conteúdo
  • Cadastre-se
crownics

Excel Macro para Hiperlink e Copiar Linhas

Posts recomendados

Pessoal, bom dia!

 

Preciso de uma ajuda, pois não entendo muito sobre VBA, etc.

Trabalho na área de logística, e devido a isso mexo muito com agendamentos. Pensando em agilizar e facilitar o controle destes agendamentos, pensei em desenvolver uma planilha, porém o que eu gostaria que ela fizesse é um pouco complexo, porém acho que possível. 

Para esta planilha, gostaria do apoio de vocês para:

 

- Queria fazer a forma "Visualizar Protocolo" abrir um .PDF que esta em uma pasta na área de trabalho, com o nome exato que contenha na célula. (No exemplo da planilha, célula H2).

 

- Também gostaria de, quando eu clicasse na forma "Entregue", todas as linhas com status "Entregue" na Coluna F, fosse copiada para a aba Entregue e excluída da aba Controle Agendamentos, e ao copiar para a outra aba, não perder nenhuma informação que lá ja estava (Não consegui fazer isto de maneira nenhuma, pois sempre apagava a linha antiga).

 

- Se possível, queria também fazer algo semelhante a forma de entregue, porém desta vez para a forma de "Cancelada", onde todas as linhas com status de "Cancelada" na Coluna F, fossem copiadas para a aba Canceladas, sem perder nenhuma informação que lá já estava.

 

Poderiam me ajudar com isso? 

 

Planilha modelo em anexo. 

 

Grato desde já.

Att.

 

Agendamento.xlsx

Compartilhar este post


Link para o post
Compartilhar em outros sites
22 minutos atrás, Muca Costa disse:

 

@Muca Costa

Testando aqui encontrei o seguinte problema:

 

- Na hora de copiar as Canceladas e ou as Entregues para a outra aba, a informação que ja tinha na aba está sendo apagada.

 

Mas de maneira geral está muito bom.

 

 

image.png

adicionado 31 minutos depois

@Muca Costa

Tambem ao Colocar mais de uma "Cancelada" Em status e clicar na forma, somente a primeira é copiada na aba "Cancelada"

Compartilhar este post


Link para o post
Compartilhar em outros sites

O que é clicar na forma?

 

Quanto a informação apagada, Substitua os dois procedimentos por:

 

Sub Entregue()
Dim P As String, UltimaLinha As String, Lin As String, i As Integer
    Planilha1.Range("F1") = "Entregue"
    P = Planilha2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    UltimaLinha = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row
    Lin = P
    For i = 3 To UltimaLinha
        If Planilha1.Cells(i, 6) = "Entregue" Then
        Planilha2.Cells(Lin, 1) = Planilha1.Cells(i, 1)
        Planilha2.Cells(Lin, 2) = Planilha1.Cells(i, 2)
        Planilha2.Cells(Lin, 3) = Planilha1.Cells(i, 3)
        Planilha2.Cells(Lin, 4) = Planilha1.Cells(i, 4)
        Planilha2.Cells(Lin, 5) = Planilha1.Cells(i, 5)
        Planilha2.Cells(Lin, 6) = Planilha1.Cells(i, 6)
        Planilha2.Cells(Lin, 7) = Planilha1.Cells(i, 7)
        Planilha2.Cells(Lin, 8) = Planilha1.Cells(i, 8)
        Remove
        Lin = Lin + 1
        End If
    Next
End Sub

Sub Cancelada()
Dim P As String, UltimaLinha As String, Lin As String, i As Integer
    Planilha1.Range("F1") = "Cancelada"
    P = Planilha3.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    UltimaLinha = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row
    Lin = P
    For i = 3 To UltimaLinha
        If Planilha1.Cells(i, 6) = "Cancelada" Then
        Planilha3.Cells(Lin, 1) = Planilha1.Cells(i, 1)
        Planilha3.Cells(Lin, 2) = Planilha1.Cells(i, 2)
        Planilha3.Cells(Lin, 3) = Planilha1.Cells(i, 3)
        Planilha3.Cells(Lin, 4) = Planilha1.Cells(i, 4)
        Planilha3.Cells(Lin, 5) = Planilha1.Cells(i, 5)
        Planilha3.Cells(Lin, 6) = Planilha1.Cells(i, 6)
        Planilha3.Cells(Lin, 7) = Planilha1.Cells(i, 7)
        Planilha3.Cells(Lin, 8) = Planilha1.Cells(i, 8)
        Remove
        Lin = Lin + 1
        End If
    Next
End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites
42 minutos atrás, Muca Costa disse:

O que é clicar na forma?

 

@Muca Costa , quando eu clico em "Entregue" ou em "Cancelada", se houver mais de uma linha de cada uma, só copia uma para a aba requerida.

adicionado 3 minutos depois

1368385427_GIF23-05-202015-28-38.thumb.gif.913b72d6a8e6368d2f807e3f99fed154.gif899080434_GIF23-05-202015-29-04.thumb.gif.de2371514a22896969e2d9b2ceb35c73.gif

Compartilhar este post


Link para o post
Compartilhar em outros sites

A chamada do procedimento Remove está no lugar errado, Abaixo os procedimentos corrigidos:

 

Sub Entregue()
Dim P As String, UltimaLinha As String, Lin As String, i As Integer
    Planilha1.Range("F1") = "Entregue"
    P = Planilha2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    UltimaLinha = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row
    Lin = P
    For i = 3 To UltimaLinha
        If Planilha1.Cells(i, 6) = "Entregue" Then
        Planilha2.Cells(Lin, 1) = Planilha1.Cells(i, 1)
        Planilha2.Cells(Lin, 2) = Planilha1.Cells(i, 2)
        Planilha2.Cells(Lin, 3) = Planilha1.Cells(i, 3)
        Planilha2.Cells(Lin, 4) = Planilha1.Cells(i, 4)
        Planilha2.Cells(Lin, 5) = Planilha1.Cells(i, 5)
        Planilha2.Cells(Lin, 6) = Planilha1.Cells(i, 6)
        Planilha2.Cells(Lin, 7) = Planilha1.Cells(i, 7)
        Planilha2.Cells(Lin, 😎 = Planilha1.Cells(i, 😎
        Lin = Lin + 1
        End If
    Next
        Remove
End Sub

Sub Cancelada()
Dim P As String, UltimaLinha As String, Lin As String, i As Integer
    Planilha1.Range("F1") = "Cancelada"
    P = Planilha3.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    UltimaLinha = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row
    Lin = P
    For i = 3 To UltimaLinha
        If Planilha1.Cells(i, 6) = "Cancelada" Then
        Planilha3.Cells(Lin, 1) = Planilha1.Cells(i, 1)
        Planilha3.Cells(Lin, 2) = Planilha1.Cells(i, 2)
        Planilha3.Cells(Lin, 3) = Planilha1.Cells(i, 3)
        Planilha3.Cells(Lin, 4) = Planilha1.Cells(i, 4)
        Planilha3.Cells(Lin, 5) = Planilha1.Cells(i, 5)
        Planilha3.Cells(Lin, 6) = Planilha1.Cells(i, 6)
        Planilha3.Cells(Lin, 7) = Planilha1.Cells(i, 7)
        Planilha3.Cells(Lin, 😎 = Planilha1.Cells(i, 😎
        Lin = Lin + 1
        End If
    Next
        Remove
End Sub

  • Obrigado 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ficou perfeito!! Obrigado!!

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

@Muca Costa

 

Vim testar ela no computador do trabalho, e não sei porque não está funcionando a formula para abrir o arquivo, eu modifiquei os endereços, porém na hora de abrir não abre. Configurei para abrir o .PDF no chrome e acaba que abre várias abas com o endereço repartido.

60710198_GIF25-05-202007-30-42.thumb.gif.73bea66af221e9e09058d5230bb61a77.gif

O endereço que coloquei é uma pasta na rede. Já testei usando o adobe reader, e também ja tentei modificar o endereço para a pasta inicial da rede (I:\) porém não abre o arquivo. 

 

Segue formula:

Sub AbrirPDF()
Dim stAppName As String, Arq As String
    Arq = Planilha1.Cells(2, 10) & ".pdf"
If Planilha1.Cells(2, 10) <> "" Then
    stAppName = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe " & "I:\01. Supply Chain\01.Transporte\Tracking\2.Tracking Indireta\Agenda\Protocolo" & "\" & Arq
    Call Shell(stAppName, 1)
End If
End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Em uma rede doméstica:

 

stAppName = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe " & "\\NOME DO COMPUTADOR NA REDE\DIRETÓRIO" & "\" & Arq

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia Sres.

Uma sugestão seria ao invés de usar o Shell, usar o método FollowHyperlink do Workbook. Ex.:

ThisWorkbook.FollowHyperlink Caminho_e_NomeArquivo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pela sugestão do Edson Luiz Branco, o evento ficaria assim:

 

Sub AbrirPDF()
Dim Arq As String
    Arq = Planilha1.Cells(2, 10) & ".pdf"
    FicheiroPDF = "D:\Downloads\" & Arq
    ThisWorkbook.FollowHyperlink FicheiroPDF
End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

@Muca Costa

2 horas atrás, Muca Costa disse:

Pela sugestão do Edson Luiz Branco, o evento ficaria assim:

 

Sub AbrirPDF()
Dim Arq As String
    Arq = Planilha1.Cells(2, 10) & ".pdf"
    FicheiroPDF = "D:\Downloads\" & Arq
    ThisWorkbook.FollowHyperlink FicheiroPDF
End Sub

Não deu certo.

image.png.1e94d302e79d38a9a5ea763245c4e0fe.png

adicionado 9 minutos depois

Colocando o nome do local da rede:

Citação

Sub AbrirPDF()
Dim stAppName As String, Arq As String
    Arq = Planilha1.Cells(2, 10) & ".pdf"
If Planilha1.Cells(2, 10) <> "" Then
    stAppName = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" & "\\SBRA080204.ferrero.net\01. Supply Chain\01.Transporte\Tracking\2. Tracking Indireta\Agenda\Protocolo" & "\" & Arq
    Call Shell(stAppName, 1)
End If
End Sub

Não funciona, da erro no depurador. 

image.thumb.png.b7413150ad21fe42eeda02af718294ad.png

Compartilhar este post


Link para o post
Compartilhar em outros sites

Não tá faltando a última barra invertida entre a pasta e o nome do arquivo?

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
15 horas atrás, Edson Luiz Branco disse:

Não tá faltando a última barra invertida entre a pasta e o nome do arquivo?

 

Acabei de testar:

image.thumb.png.029558c5df450902307bc26c0a0a5d00.png

Compartilhar este post


Link para o post
Compartilhar em outros sites

Alguma coisa deve estar errada no caminho ou no nome do arquivo retornado pela variável pra não estar abrindo.

Façamos um teste: estando o código interrompido nesse ponto que você mostrou acima, no Editor do VBA exiba a Janela Imediata (Ctrl G) e digite:

?FicheiroPDF

após dar Enter, copie o retorno, abra o Windows Explorer e cole na barra de endereços. Verifique o que acontece...

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

 

javaweb-popup.jpg

CURSO ONLINE DE PROGRAMAÇÃO
FULL STACK

Entre para o mercado que paga mais de R$ 12.000 por mês e não tem crise!

CLIQUE AQUI E INSCREVA-SE AGORA MESMO!