automatically saving with a password

Yes and no, you can get the SaveAs Dialog as:

Application.Dialogs(xlDialogSaveAs).Show

to open the Excel Save As form. When "Cancel" is selected, an event macro can run the xlDialogSaveAs form, but the password dialog form is selected from the Save As form. So, you cannot code the password dialog into a macro without closing the SaveAs dialog first, which cannot work. The password option is selected by clicking Tools on the Save As form, then General Options to set passwords, this is the part you cannot get to with code. You can hard code the password, you just can't get the dialog by code! JSW

thanks. could you please demonstarates it. thanks

Demonstrate what I gave you three scenarios, which one?

The first one just uses a sub to pull the one line of code, try that first to see if that the direction you want to go in.

Sub mySave()
Application.Dialogs(xlDialogSaveAs).Show
End Sub

The other is the cancel event Private Sub.

Private Sub Workbook_BeforeClose(Cancel as Boolean)
If Me.Saved = False Then Me.Dialogs(xlDialogSaveAs).Show
End Sub

In the ThisWorkBook module. JSW

Note: the code to stop Excel from automatically saving a file on close and alowing you the option of the Save As form, had a slight error use this one.

Private Sub Workbook_BeforeClose(Cancel as Boolean)
If Me.Saved = False Then Me.Application.Dialogs(xlDialogSaveAs).Show
End Sub

Just copy it to the ThisWorkBook module. Note: If you test it you will see that when Excel askes you if you want to save befor closing?
And, you say yes and you have saved it before but have made changes since then. The default for Excel would be to save the file with its current file name. The code forces Excel to display the Save As form. JSW

I think this may help you out;
It essentially works of the workbook befoe close
event....prompts you for the dir to save to
Prompts for the password
then attempts to save as
Change as required............

PLEASE TEST....before implimenting as I haven't
fully tested it....
I've commented where poss POST if unsure

IN the ThisWorkbook Object place this code;

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sQ As String
ThisWorkbook.Saved = True
sQ = MsgBox("Do you wish to save this workbook ?", vbYesNoCancel)
If sQ = vbCancel Then Cancel = True
If sQ = vbYes Then
If FSaveAs = False Then
Cancel = True
End If
End If
End Sub

In a Module place this code;

Option Explicit

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'Converts an item identifier list to a file system path.
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'· pidl
'Pointer to an item identifier list that specifies a file or directory
'location relative to the root of the name space (the desktop).

'· pszPath
'Pointer to a buffer that receives the file system path.
'The size of this buffer is assumed to be MAX_PATH = 260 bytes.

'Returns a pointer to an item identifier list that specifies the location of
'the selected folder relative to the root of the name space. If the user
'chooses the Cancel button in the dialog box, the return value is NULL.
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'lpbrowseinfo = Pointer to a BROWSEINFO structure that contains information
'used to display the dialog box.

Function GetFolderName(msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long, X As Long, pos As Integer

bInfo.pidlRoot = 0& ' Root folder = Desktop

If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder." ' the Default dialog title
Else
bInfo.lpszTitle = msg ' the User defined dialog title
End If

bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
path = Space$(512) ' Parse the result
r = SHGetPathFromIDList(ByVal X, ByVal path) '

If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If

End Function

Function FSaveAs() As Boolean
Dim sDir As String
Dim sFilePwd As String
Dim sFileName As String

FSaveAs = False

sDir = GetFolderName("Please Select a folder to SaveTo")
If sDir = "" Then Exit Function

sFilePwd = Application.InputBox("Enter password", Type:=2)
If sFilePwd = "False" Then Exit Function

'sFileName = Sheet1.[A1]

On Error GoTo FileError
ActiveWorkbook.SaveAs Filename:=sDir & "\" & activeworkbook.name, _
FileFormat:=xlNormal, Password:=sFilePwd
FSaveAs = True
Exit Function
FileError:
MsgBox Err.Number & Chr(13) & _
Err.Description & Chr(13), _
vbCritical + vbMsgBoxHelpButton, "ERROR", _
Err.HelpFile, Err.HelpContext
FSaveAs = False
End Function

HTH

Ivan