Bom dia a todos!
Estou com um problema com o SAVEAS, eu consigo salvar o arquivo com dados em uma determinada célula, porém, se o arquivo já existe aparece a mensagem de confirmação do overwrite, se eu clico sim, beleza, o problema aparece quando clico em não ou em cancelar.
Aparece um pop-up informando "Erro em tempo de execução '1004'."
Gostaria que fechasse a janela para poder mudar o valor da célula, e salvar corretamente.
Trabalho com orçamentos, por isso não posso usar o Application.DisplayAlerts.
Já procurei em muitos sites e não consegui achar algo que me ajudasse, já procurei em inglês também.
Uso Excel 2003 e 2007.
Segue o código
Sub SalvarComo()
Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
fname = Application.GetSaveAsFilename(InitialFileName:="\SERVER2012S-0" & Range("A10").Value & "S-12-", _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")
If fname <> False Then
ActiveWorkbook.Save
Set NewWb = ActiveWorkbook
NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
Set NewWb = Nothing
End If
Else
fname = Application.GetSaveAsFilename(InitialFileName:="\SERVER2012S-0" & Range("A10").Value & "S-12-", _
filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 97-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=3, Title:="This example copies the ActiveSheet to a new workbook")
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
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else
ActiveWorkbook.Save
Set NewWb = ActiveWorkbook
'O erro fica nessa parte em destaque
NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False
Set NewWb = Nothing
End If
End If
End If
End Sub
Desde já agradeço
Akira
Postado : 17/07/2012 7:28 am