Excel Macro para "salvar como" SEM macro

[Josy Lobo]

Olás.

Tenho uma planilha matriz que se abre em somente leitura, recebe dados e deve ser salva como um novo arquivo.

 

Tenho uma macro nela que faz assim:

 

Dim Nome As String
Nome = Worksheets(1).Range("d1")          'D1 tem uma fórmula derivada de HOJE()

ActiveWorkbook.SaveAs Filename:="Controle Painel " & Nome & ".xlsx", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
 

 

Primeiro problema: preciso que o arquivo seja salvo na mesma pasta de onde está a matriz, sem especificar o caminho, pois são três máquinas diferentes com o mesmo arquivo base.

 

Segundo problema: o arquivo matriz é "xlsm". Mesmo forçando o salvamento para "xlsx", quando abre, as macros funcionam. Preciso que esses arquivos gerados não tenham nenhuma macro.

 

 

Alguém, prissss?

 

 

[Josy Lobo]

Primeiro problema resolvido.

Ficou assim:

                   

Dim Nome As String
                    Nome = Worksheets(1).Range("d1")          'D1 tem uma fórmula derivada de HOJE()
                    
                    Dim Endereço As String
                    Endereço = Replace(ThisWorkbook.FullName, "ThisWorkbook.Name", "")

                       

                         'FullName é o nome completo do arquivo

                         'Name é somente o nome do arquivo

                          'Replace......  joga na variável somente o caminho, tirando o nome do arquivo 



                    ActiveWorkbook.SaveAs Filename:=Endereço & "Controle Painel " & Nome & ".xlsx", _
                    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                    ReadOnlyRecommended:=False, CreateBackup:=False

 

 

 

Agora é a segunda parte que me mata................... 

[CasaDoHardware]

Tente assim:


 

Sub Salvar()
    
Dim W As Worksheet
Dim Arq As String

    
Set W = Sheets("Plan1")
    
    
    
    'Este é o Nome do Novo Arquivo XLSX
    
Arq = "Nome do arquivo"
    
    'Salva o arquivo na Pasta EscolhidaClientes
    
    ChDir "C:\Clientes" 'Atere o nome e o caminho da pasta
    
    ActiveWorkbook.SaveAs Filename:="C:\Clientes\" & Arq & ".xlsx"
    ActiveWorkbook.Close
    
    MsgBox "Dados do Cliente Salvo com Sucesso", vbOKOnly, "Atenção"
        
End Sub

 

[Josy Lobo]

@CasaDoHardware Olá!

 

Então, a parte do caminho eu consegui resolver. Falta a questão de desabilitar as macros. Dei um balão no excel colocando uma verificação. Quando ele gera o segundo arquivo, coloca uma informação numa determinada célula. Daí TOOOODAS as macros, antes de rodar verifica isso. Se ela existir, dá uma mensagem "Comando exclusivo para o arquivo matriz" .

Resolveu, mas isso chega a ser indigno, né?

kkkk fala sério....

 

 

Desculpa a ignorância, mas como é que faz pro código ficar desse jeito no post?

[CasaDoHardware]

O codigo ja salva sem as macros.

Ou seja o arqquivo gerado nao tera nenhuma macro.

 

 

Para postar o codigo igual ao que fiz basta usar a função code repreentada na barra de ferramentas por <>

[Patropi]

@PlayerMamuska

Nesta página acima da descrição do tópico, temos 2 comunicados, sendo que o segundo, contém uma explicação sobre a obrigatoriedade de usar a ferramenta ao postar codigos

 

[]s

[Basole]

Segue exemplo adaptado que salva no formato *.xlsx,(s/ as macros), e na mesma pasta onde está o arquivo.

    Dim FileExtStr     As String
    Dim FileFormatNum  As Long
    Dim Sourcewb       As Workbook
    Dim Destwb         As Workbook
    Dim TempFilePath   As String
    Dim TempFileName   As String
    Dim Nome           As String
    
    On error goto Erro:
    Nome = ThisWorkbook.Worksheets(1).Range("d1")
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook     
   
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
   
    With Destwb
        If Val(Application.Version) < 12 Then ' se Excel 2003
           
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
    End With
   
        With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
   
    TempFilePath = ThisWorkbook.Path & "\"
    TempFileName = "Controle Painel " & Nome

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close SaveChanges:=False
    End With

    MsgBox "Você pode encontrar o novo arquivo em " & TempFilePath
Erro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

fonte: https://www.rondebruin.nl/win/s5/win001.htm