Notifications
Clear all

Problemas com o SAVEAS

2 Posts
2 Usuários
0 Reactions
647 Visualizações
(@smiletoshi)
Posts: 1
New Member
Topic starter
 

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
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!
Tente algo....

On Error GoTo CheckError

'Coloque seu código aqui

On Error GoTo 0
Exit Sub
CheckError:
If Err.Number = 1004 Then
MsgBox "O arquivo já existe, por favor atualize referência de célula"
Exit Sub
Else
MsgBox "Erro desconhecido: " & Err.Number & " - Exiting sub."
End If

att

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

 
Postado : 18/07/2012 5:49 am