Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por AlanBC 10 Jul 2019 às 20:47
Membro 1 Estrela
Mensagens: 54
Reputação: 3
#45466
ola pessoal...

tive a ajuda de um amigo aqui do forum conforme precisava, mas logo surgiu outra necessidade no codigo, uma condicao nova que nao tinha relatado anteriomente. e preciso contar mais uma vez com ajuda...

o codigo é uma rotina pra abrir ou ativar uma outra pasta de trabalho, e se ja estiver aberta, ativa a pasta;

agora preciso, impedir que o arquivo "Cronograma_Cursos.xlsx" seja aberto, caso o arquivo "Pasta1.xlsx", seja renomeado ou usarem o "salvar como" ou tiver um backup com outro nome, nao abra o arquivo "Cronograma_Cursos.xlsx"

acho q poderia incluir uma condicao( if ou algo ) com o diretorio e nome do arquivo ("c:\....\Pasta1.xlsx"), pra checar se esse diretorio coincide com da pasta ativa: e se NAO for verdadeiro (não coincidir) encerra com "msgbox" "acesso nao permitido!"; mas se for verdadeiro (coincidir), abre o arquivo ou ativa a "Cronograma_Cursos.xlsx" pela macro.

abaixo o codigo que recebi (Pasta1.xlsx):

Código: Selecionar todosOption Explicit
Public Sub AbrirPastaTrabalho()
    Const strNomeArq As String = "Cronograma_Cursos.xlsx"
    Const strCaminho As String = "D:\Cursos"
    Dim wbk As Workbook
    If PastaAberta(strNomeArq:=strNomeArq) Then
        Workbooks(strNomeArq).Worksheets(1).Range("A1").Activate
    Else
        Set wbk = Workbooks.Open(Filename:=strCaminho & "\" & strNomeArq)
        wbk.Worksheets(1).Range("A1").Activate
    End If
End Sub

Private Function PastaAberta(strNomeArq As String) As Boolean
    Dim wbk     As Workbook
    Dim lngCont As Long
    For Each wbk In Application.Workbooks
        If wbk.Name = strNomeArq Then
            PastaAberta = True
            lngCont = lngCont + 1
        End If
    Next wbk


obrigado a todos
no aguardo
abraços
Por babdallas 11 Jul 2019 às 10:40
Membro 5 Estrelas
Mensagens: 1749
Reputação: 778
#45475
Pasta1.xlsm seria o arquivo que contém este código VBA? Se sim, você deseja que só abra (ou selecione) o a pasta de trabalho Cronograma_Cursos.xlsx se a pasta de trabalho atual se chamar Pasta1.xlsx e estiver contida em uma pasta específica do computador (Ex: C:\Temp)?
Por AlanBC 11 Jul 2019 às 18:21
Membro 1 Estrela
Mensagens: 54
Reputação: 3
#45491
boa tarde amigo.
"Pasta1.xlsm seria o arquivo que contém este código VBA? Se sim, você deseja que só abra (ou selecione) o a pasta de trabalho Cronograma_Cursos.xlsx se a pasta de trabalho atual se chamar Pasta1.xlsx e estiver contida em uma pasta específica do computador (Ex: C:\Temp)?"
sim. exatamente isso!
obrigado.
Por babdallas 11 Jul 2019 às 20:03
Membro 5 Estrelas
Mensagens: 1749
Reputação: 778
#45496
Veja se isso ajuda:

Código: Selecionar todosOption Explicit
Public Sub AbrirPastaTrabalho()
    Const strNomeArq As String = "Cronograma_Cursos.xlsx"
    Const strCaminho As String = "D:\Cursos"
    Const strCaminhoAtual as String = "C:\Temp\Pasta1.xlsm"

    Dim wbk As Workbook
    If ThisworkBook.Fullname <> strCaminhoAtual then exit sub

    If PastaAberta(strNomeArq:=strNomeArq) Then
        Workbooks(strNomeArq).Worksheets(1).Range("A1").Activate
    Else
        Set wbk = Workbooks.Open(Filename:=strCaminho & "\" & strNomeArq)
        wbk.Worksheets(1).Range("A1").Activate
    End If
End Sub

Private Function PastaAberta(strNomeArq As String) As Boolean
    Dim wbk     As Workbook
    Dim lngCont As Long
    For Each wbk In Application.Workbooks
        If wbk.Name = strNomeArq Then
            PastaAberta = True
            lngCont = lngCont + 1
        End If
    Next wbk
end Function