Microsoft 365 Worksheet.saveas

[Trotilde]

Bonjour,

Je souhaite réaliser une macro qui me permette
1. à l'ouverture de mon fichier : OK trouvé
2. d'ouvrir le pop up Save As : OK trouvé
3. d'automatiquement sélectionner un chemin d'accès qui contient le nom d'utilisateur Windows
Ex type C:\Users\UserName\NO BACKUP\ [oui il y a en plus un espace dans le nom de dossier ...]
avec UserName étant récupéré de la session Windows de l'utilisateur
4. laisser le choix à l'utilisateur de choisir le nom de fichier
5. Enregistrer sous format .xlsx le fichier [alors que le format initial était .xlsm]

Points 1 et 2 ok avec le 4.

Le code ci-dessous fonctionne mais m'enregistre un fichier dans un format inconnu que je n'arrive pas à ouvrir (car pas d'extension).
Si je change la liste ThisWorkbook.SaveAs a par ThisWorkbook.SaveAs a & ".xlsx", j'obtiens l'erreur 1004 lorsque je clique sur Enregistrer.

Private Sub Workbook_Open()

Dim a As String

Dim Msg, Style, Title, Response
Msg = "Message"    ' Define message.
Style = vbOKOnly + vbInformation  ' Define buttons.
Title = "User Box"    ' Define title.

        ' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbOK Then    ' User chose OK.
      a = Application.GetSaveAsFilename
        If Format(a) <> False Then
            ThisWorkbook.SaveAs a
        End If ' Perform some action.
Else         ' Perform no action.
End If

End Sub

Les points 3 et 5 ne sont donc pas résolus... pourriez vous m'aider svp ?

Merci d'avance

 

[Robert]

Bonjour Trotilde, bonjour le forum,

Peut-être comme ça :

Private Sub Workbook_Open()
Dim Msg As String, Style As Integer, Title As String, Response As Integer
Dim UN As String
Dim CA As String
Dim A As Variant

Msg = "Message"
Style = vbOKOnly + vbInformation
Title = "User Box"
UN = Application.UserName
CA = "C:\Users\" & UN & "\Documents\NO BACKUP\"
Response = MsgBox(Msg, Style, Title)
If Response = vbOK Then
    A = Application.GetSaveAsFilename(CA, "Fichier Excel,*.xlsx")
    If A <> False Then ThisWorkbook.SaveAs A, FileFormat:=-4143
End If
End Sub