Excel Macro para Hiperlink e Copiar Linhas

[crownics]

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

[Muca Costa]

Veja se ajuda...

 

Agendamento.rar

[crownics]

22 minutos atrás, Muca Costa disse:

Veja se ajuda...

 

Agendamento.rar 23.4 kB · 2 downloads

 

@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.

 

 

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"

[Muca Costa]

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

[crownics]

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

[Muca Costa]

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

[crownics]

Ficou perfeito!! Obrigado!!

 

[crownics]

@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.

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

 

[Muca Costa]

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

[Edson Luiz Branco]

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

 

[Muca Costa]

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

[crownics]

@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.

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. 

[Edson Luiz Branco]

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

 

[crownics]

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:

[Edson Luiz Branco]

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...

[crownics]

Em 26/05/2020 às 08:46, Edson Luiz Branco disse:

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...

Deu certo.