Notifications
Clear all

Caixa de Diálogo "Salvar Como" com formato pré-definido

3 Posts
1 Usuários
0 Reactions
1,316 Visualizações
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Prezados, boa noite.

Nas idas e vindas de VBA me deparei com uma dúvida: seria possível criar uma macro que abrisse a caixa de diálogo "Salvar Como" já definindo o formato como "Pasta de Trabalho Habilitada para Macro do Excel"?

Procurei por aqui, por alí, vi muitas coisas, mas nada conclusivo. No máximo consegui identificar o seguinte:

• A macro tem que ter "Application.Dialogs(xlDialogSaveAs).Show"
• O formato tem que ser "xlOpenXMLWorkbookMacroEnabled"

O problema é: como juntar tudo isso? Outra coisa: não quero que ele me defina já o nome do arquivo ou o caminha a ser salvo, preciso apenas que ele abra o salvar como e já exiba "Pasta de Trabalho Habilitada para Macro do Excel", ou seja, o formato .xlsm, como padrão.

Agradeço a colaboração de todos.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/02/2012 3:53 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

A rotina abaixo é bem completa e verifica a versão do excel :

Fonte :
Use VBA SaveAs in Excel 2007-2010
http://www.rondebruin.nl/saveas.htm

Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2010
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the
        'new formats. Use the "Save as type" dropdown to make a choice,Default =
        'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", 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:="This example copies the ActiveSheet to a new workbook")

        'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub

Tem outros exemplos no site acima, e abaixo a relação dos formatos :
XlFileFormat Enumeration
http://msdn.microsoft.com/en-us/library ... 12%29.aspx

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/02/2012 5:35 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde, Mauro.

Onde tem "FilterIndex:=2" alterei para "FilterIndex:=1", que atende perfeitamente ao que eu preciso. Muito obrigado!

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 13/02/2012 2:05 pm