none
Mudar código VBA dentro de outro arquivo do Excel RRS feed

  • Pergunta

  • TÓPICO ENCERRADO

    A quem interessar, eu consegui fazer o código funcionar com arquivos .XLSM

    eu coloquei esta linha e o código funciona perfeitamente:

    ActiveWorkbook.Application.EnableEvents = False

    Bom dia a todos, sou novato em VBA/Excel e preciso de ajuda com uma coisa.

    Eu preciso renomear mais 5000 arquivos XLS para XLSM.

    A rotina para isso eu consegui fazer.

    O problema está no fato de os arquivos que serão renomeados terem um botão chamado ENCERRAR. O código que está nesses arquivos força o usuário a clicar no botão ENCERRAR para fechar o Excel.

    Dessa forma, eu não consigo fazer um código para abrir os arquivos, renomeá-los e fechá-los automaticamente.

    Abaixo segue o código que estou usando. Obrigado desde já a todos que puderem ajudar.

        

    Sub Salvar_Como()

    Dim FSO As Object
    Dim Pasta_Origem, Pasta_Destino As String
    Dim Planilha As Object
    Dim OpenBook As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Pasta_Origem = "C:\ptrf_SME\2015\01_repasse\teste" 'Pasta com as planilhas que serão abertas e copiadas

    Pasta_Destino = "C:\ptrf_SME\2015\01_repasse\teste\novos" 'Pasta onde as planilhas serão salvas


    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    For Each Planilha In FSO.GetFolder(Pasta_Origem).Files

    If InStr(1, Planilha, ".xls") = 0 Then GoTo PRÓXIMO

    Workbooks.Open (Planilha)
    OpenBook = ActiveWorkbook.Name

    ActiveWorkbook.SaveAs Pasta_Destino & "\" & _
    Left(ActiveWorkbook.Name, WorksheetFunction.Search(".", ActiveWorkbook.Name, 1) - 1) & ".xlsm", 52

    Workbooks(ActiveWorkbook.Name).Close

    PRÓXIMO:
    Next

    Application.ScreenUpdating = True

    MsgBox "Dados Copiados com Sucesso!", vbInformation, "Aviso"

    Application.Calculation = xlCalculationAutomatic

    End Sub

    Sub FechaTudo()

        Dim iWB As Workbook

        For Each iWB In Workbooks
            iWB.Close SaveChanges:=False
        Next iWB

    End Sub


    Private Sub CommandButton1_Click()
    Salvar_Como

    End Sub



    • Editado Leandro Sarno sexta-feira, 23 de novembro de 2018 15:32
    sexta-feira, 23 de novembro de 2018 11:29

Respostas