Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Ajuda Código VBA Sa...
 
Notifications
Clear all

Ajuda Código VBA Salvar como.

 
2024 - VBA & Macros
Post Recente por teleguiado 8 anos atrás
6 Posts
2 Usuários
0 Reactions
1,214 Visualizações
RSS
 teleguiado
(@teleguiado)
Posts: 0
New Member
Topic starter
 

Boa Tarde!!

Bom pessoal preciso de uma ajuda com um código de salvar abaixo:

Sub Salvarplan1eplan2()

    Dim FName1 As Variant
    Dim FName As Variant
 
  Application.Visible = False
   Workbooks.Add
Do
    FName = InputBox("Qual o nome do Arquivo?")
Loop Until FName <> False
    MsgBox "O arquivo deverá ser gravado habilitado para macro .xlsm"
    Application.Dialogs(xlDialogSaveAs).Show FName & ".xlsm"
      Windows("consolidado.xlsm").Activate
    Sheets("teste1").Select
    Sheets("teste1").Copy Before:=Workbooks(FName & ".xlsm").Sheets(1)
    Windows("consolidado.xlsm").Activate
    Sheets("teste2").Select
    Sheets("teste2").Copy Before:=Workbooks(FName & ".xlsm").Sheets(1)
Windows("consolidado.xlsm").Activate
Windows(FName & ".xlsm").Activate
Application.Visible = True
End Sub

Gostaria de que fosse disponibilizada somente a opção de salvar como macro .xlsm ou que fosse escolhido ja a opção de salvar como macro na caixa de opção de salvar como.

Já tentei adaptar o código abaixo porem não funciona do jeito que quero, pois a planilha tem q ficar ativa e o código abaixo fecha o arquivo.

'    FName1 = Application.GetSaveAsFilename(InitialFileName:=FName, filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="Salva o Teste1 e a Teste2 em um arquivo separado")

'http://www.rondebruin.nl/win/s5/win001.htm

Obrigado.

 
Postado : 31/01/2017 3:07 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Duas perguntas ?

Pq precisa salvar as macros?

Pq usar o salvar como se pode salvar direto com o nome pre definido.

Basta definir o local onde devera ser salvo?

Se for backup da pra fazer tudo no automatico.

Tenho a impressão que vc esta complicando, sem necessidade. :D

 
Postado : 31/01/2017 5:22 pm
 teleguiado
(@teleguiado)
Posts: 0
New Member
Topic starter
 

MPrudencio, não estou salvando macro e sim salvando um arquivo que tem várias abas e preciso de duas planilhas para ser salva em outro arquivo com o nome do arquivo que pode variar e a pasta onde deve ser salva também. ;)
Sei que existe códigos que salvam direto porem quero que a pessoa escolha o nome e o local do salvamento. :)
Não é para backup. ;)
Caso tenha interesse no link abaixo tem um modelo dela. O código acima ainda não estava na planilha no link abaixo.

http://www.tomasvasquez.com.br/forum/viewtopic.php?f=20&t=4469

 
Postado : 31/01/2017 7:01 pm
 teleguiado
(@teleguiado)
Posts: 0
New Member
Topic starter
 

Ninguém. ;)

 
Postado : 24/02/2017 3:28 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

A linha de codigo abaixo abre a caixa de dialogo salvar como

Application.Dialogs(xlDialogSaveAs).Show

Talvez esse link ajude

viewtopic.php?f=10&t=3461

 
Postado : 24/02/2017 5:25 pm
 teleguiado
(@teleguiado)
Posts: 0
New Member
Topic starter
 

MPrudencio, estava usando o argumento errado no código segue código conforme preciso.

Sub Salvarplan1eplan2()

    Dim FName As Variant
    
  
  Application.Visible = False

 
   Workbooks.Add
Do
    FName = InputBox("Qual o nome do Arquivo?")
Loop Until FName <> False
    
    Application.Dialogs(xlDialogSaveAs).Show Arg1:=FName, Arg2:=xlOpenXMLWorkbookMacroEnabled

   
    Windows("consolidado.xlsm").Activate
    
    Sheets("teste1").Select


    Sheets("teste1").Copy Before:=Workbooks(FName & ".xlsm").Sheets(1)
    
    
    Windows("consolidado.xlsm").Activate
    
    Sheets("teste2").Select
    
    
    Sheets("teste2").Copy Before:=Workbooks(FName & ".xlsm").Sheets(1)


Windows("consolidado.xlsm").Activate

Windows(FName & ".xlsm").Activate

Application.Visible = True

End Sub

Obrigado pela ajuda.

 
Postado : 27/02/2017 8:33 am
Forum Jump:
  Tópico Anterior
Próximo Tópico