Run Macro Save AS

[Evertonx]

Hello,
need some help

I need the worksheet is saved with the name that is in cell A1
The following macro can accomplish what I need, but I need to call this macro automatically when I save by doing the following path File -> Save As ...
When I click File -> Save As, the macro runs, opens a dialog box with the text in cell A1, (is what I need), but after save, opens another dialog box to save again.
I want to save only 1x.

This Workbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call SaveAS
End Sub

Module

Sub SaveAS()
Dim fname
ChDrive (Left(ThisWorkbook.Path, 1))
ChDir ThisWorkbook.Path
reference = Range("A1").Value & " " & "-" & " " & Format(Now, "dd-mm-yyyy-hhmmss")
fname = Application.GetSaveAsFilename(reference, FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Save As")
If fname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=fname
End Sub

[Bob Phillips]

Add Cancel = TRUE to the event procedure.

[Evertonx]

Add Cancel = TRUE to the event procedure.

not solved
still opens 2 times this dialog and now the file is not saved

[Bob Phillips]

I forgot an important point, turn events off (I had to rename SaveAS to SaveASx)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo wb_exit
    Application.EnableEvents = False
    Cancel = True
    Call SaveASx
wb_exit:
    Application.EnableEvents = True
End Sub

[Evertonx]

I forgot an important point, turn events off (I had to rename SaveAS to SaveASx)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo wb_exit
    Application.EnableEvents = False
    Cancel = True
    Call SaveASx
wb_exit:
    Application.EnableEvents = True
End Sub

Now it worked

xld, Thank you so much