Help needed:Application.SaveAs, BeforeSave KO si appel via bouton Active X

[slm]

Hello à tous,
j'ai un soucis actuellement: j'ai vais une petite méthode VB pour proposer un nom de sauvegarde quand on fait ctrl-S ou quand on clique sur un bouton.

Ca fonctionne très bien via CTRl-S. Par contre quand on clique sur le bouton Active X Thisworkbook.SaveAs ne fait rien.

Un exemple vaut mieux qu'un long discours ;-). Cf pièce attachée.


Quand je clique sur le bouton Save de la feuille 1 => pas de sauvegarde en truc.xls (pas de sauvegarde du tout d'ailleurs)
Quand je clique sur la disquette ou fichier => save ou fichier => SaveAs ca fonctionne => classeur1.xls est bien sauvegardé en truc.xls.

J'ai beau cherché je ne trouve pas la solution.

Help needed please car ca commence à me rendre fou ce truc. 😡

PS: c'est un exemple en PJ car dans mon "vrai" fichier le clic sur le bouton fait plein d'autres choses avant (envoi de mail, alimentation d'un fichier consolidé,...)

 

[slm]

Re : Help needed:Application.SaveAs, BeforeSave KO si appel via bouton Active X

Quelqu'un pour m'aider?

 

[JNP]

Re : Help needed:Application.SaveAs, BeforeSave KO si appel via bouton Active X

Bonjour Slm 🙂,
D'abord, mets tes fonctions dans un module

Sub doSaveAs([COLOR=red][B]MyFileName[/B][/COLOR] As String)
    Dim fileSaveName As String
    ' ouverture de la boite save As
    fileSaveName = Application.GetSaveAsFilename(ThisWorkbook.Path & "\" & [COLOR=red][B]MyFileName[/B][/COLOR], "MS Spreadsheet Files (*.xls), *.xls")
    ' choix cancel
    If fileSaveName = "Faux" Or fileSaveName = "False" Then
        'annulation de la sauvegarde
    'choix OK
    Else
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs FileName:=fileSaveName
        Application.DisplayAlerts = True
    End If
End Sub
Function GetFileNameWithOutExt() As String
    Dim intI As Integer
    GetFileNameWithOutExt = ActiveWorkbook.Name
    intI = InStrRev(GetFileNameWithOutExt, ".", -1, vbTextCompare)
    If intI <> 0 Then
        GetFileNameWithOutExt = Left(GetFileNameWithOutExt, intI - 1)
    End If
End Function

et surtout, change le nom de ta variable, on n'utilise jamais les termes VBA...
Après, modifies ton clic

Private Sub CommandButton1_Click()
    Dim fileSaveNameToUse As String
    ThisWorkbook.Save
    fileSaveNameToUse = Feuil1.Range("B2").Value
    Call doSaveAs(fileSaveNameToUse)
End Sub

Ça a l'air de fonctionner chez moi 🙄.
Bonne journée 😎