Wagner Morel
Muito obrigado pela resposta.
Na hora de rodar a macro, ele da erro de compilação em (Destaque em vermelho):
Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs).InitialFileName = "Pasta de Trabalho Habilitada para Macro do Excel*.*"
Porque?
No momento estou usando a seguinte macro:
Sub Copy_ActiveSheet_New_Workbook()
'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog that you
'only see when you copy a sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
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 If
End With
' 'If you want to change all cells in the worksheet to values, uncomment these lines.
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
'Save the new workbook and close it
TempFilePath = Application.DefaultFilePath & ""
TempFileName = Sourcewb.Name
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With
MsgBox "Seu arquivo foi salvo em " & TempFilePath
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Porém, eu estou usando VBA para enviar o Arquivo via Outlook para 5 pessoas na empresa, e eu acho mais interessante a macro que você está me ajudando, pois, ela permite o usuário salvar aonde ele quer, e a de cima tem um local predefinido.
PS:Vou anexar meu arquivo, talvez futuramente ajude alguém, com a macro acima e/ou a de enviar e-mails com arquivos em anexo pelo Outlook.
Postado : 19/06/2013 8:40 am