Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel macro avec choix dossiers pour sauvegarder

macro avec choix dossiers pour sauvegarder

3 réponses
Avatar
DC
Bonsoir à tous,..................et bonne soirée...!!

Merci d'avance...!!

Serait-il possible avec une macro, de sauvegarder un classeur nommé "
Facture ", dans un Dossier " Daniel tous ensembles " et dans lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA, pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,

Salutations!............encore Merci...!!...................DC
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour DC,

Essaie ceci :

Tu dois renseigner la variable Chemin dans la procédure.

'--------------------------------
Sub EnregistrerSous()

Dim Chemin As String
Dim Fichier As String
Dim LeString As Variant
LeString = Array("*", "?", ":", "/", "", "[", "]")

Chemin = "c:ATravail" 'A renseigner

Fichier = Application.InputBox _
("Insérérer le nom du fichier.", "Nom du fichier")
'Où est ledit répertoire
If Fichier = "Faux" Then
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
For Each elt In LeString
If InStr(1, Fichier, elt, vbTextCompare) <> 0 Then
If MsgBox("interdiction d'utiliser ces symboles : " & _
vbCrLf & vbCrLf & _
"""*"", ""?"", "":"", ""/"", """", ""["", ""]""" & _
vbCrLf & vbCrLf & "dans le nom d'un fichier." & _
vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
vbCritical + vbYesNo) = vbYes Then
EnregistrerSous
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
Next
If Right(Fichier, 4) <> ".XLS" Then
Fichier = Fichier & ".xls"
End If

Chemin = ChoixDossier(Chemin)
If Chemin <> "" Then
If MsgBox("Votre fichier sera enregistrer là : " & _
vbCrLf & vbCrLf & Chemin & "" & Fichier & vbCrLf & vbCrLf & _
"Désirez-vous continuez?", _
vbYesNo + vbInformation, "Enregistrer sous") = vbYes Then
ThisWorkbook.SaveAs Chemin & "" & Fichier
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If

End Sub
'----------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
If objFolder Is Nothing Then
ChoixDossier = ""
Else
ChoixDossier = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function
'----------------------------------


Salutations!


"DC" a écrit dans le message de news: 437a1baa$0$18332$
Bonsoir à tous,..................et bonne soirée...!!

Merci d'avance...!!

Serait-il possible avec une macro, de sauvegarder un classeur nommé "
Facture ", dans un Dossier " Daniel tous ensembles " et dans lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA, pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,

Salutations!............encore Merci...!!...................DC
Avatar
DC
Bonjour à tous.......................Bonjour michdenis,

...................................Bonne Journée...!!

Merci beaucoup, de ta positivité à répondre...!!

Alors là, Chapeau...!!.....c'est plus-que parfait et du premier coup,

Je vais t'avouer, que lorsque j'ai vu la procédure, je me suis dit, que
jamais, je ne pourrais m'en sortir, trop compliquée pour moi, et pourtant,
en suivant bien à la lettre t'es directives, le résultat est surprenant, çà
me fait plaisir et suis fier de discuter avec des Gens comme
toi............Merci...!!............

Faut que je te dise à quel point, j'apprécie t'es interventions, c'est
presque magique,

Salutation!.............encore Merci...!!..............DC

"michdenis" a écrit dans le message de news:

Bonjour DC,

Essaie ceci :

Tu dois renseigner la variable Chemin dans la procédure.

'--------------------------------
Sub EnregistrerSous()

Dim Chemin As String
Dim Fichier As String
Dim LeString As Variant
LeString = Array("*", "?", ":", "/", "", "[", "]")

Chemin = "c:ATravail" 'A renseigner

Fichier = Application.InputBox _
("Insérérer le nom du fichier.", "Nom du fichier")
'Où est ledit répertoire
If Fichier = "Faux" Then
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
For Each elt In LeString
If InStr(1, Fichier, elt, vbTextCompare) <> 0 Then
If MsgBox("interdiction d'utiliser ces symboles : " & _
vbCrLf & vbCrLf & _
"""*"", ""?"", "":"", ""/"", """", ""["", ""]""" & _
vbCrLf & vbCrLf & "dans le nom d'un fichier." & _
vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
vbCritical + vbYesNo) = vbYes Then
EnregistrerSous
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
Next
If Right(Fichier, 4) <> ".XLS" Then
Fichier = Fichier & ".xls"
End If

Chemin = ChoixDossier(Chemin)
If Chemin <> "" Then
If MsgBox("Votre fichier sera enregistrer là : " & _
vbCrLf & vbCrLf & Chemin & "" & Fichier & vbCrLf & vbCrLf & _
"Désirez-vous continuez?", _
vbYesNo + vbInformation, "Enregistrer sous") = vbYes Then
ThisWorkbook.SaveAs Chemin & "" & Fichier
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If

End Sub
'----------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
If objFolder Is Nothing Then
ChoixDossier = ""
Else
ChoixDossier =
objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function
'----------------------------------


Salutations!


"DC" a écrit dans le message de news:
437a1baa$0$18332$
Bonsoir à tous,..................et bonne soirée...!!

Merci d'avance...!!

Serait-il possible avec une macro, de sauvegarder un classeur nommé "
Facture ", dans un Dossier " Daniel tous ensembles " et dans lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA, pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,

Salutations!............encore Merci...!!...................DC





Avatar
twikii
Le mardi 15 Novembre 2005 à 18:32 par DC :
Bonsoir à tous,..................et bonne soirée...!!
Merci d'avance...!!
Serait-il possible avec une macro, de sauvegarder un classeur nommé
"
Facture ", dans un Dossier " Daniel tous ensembles " et dans
lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA,
pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,
Salutations!............encore Merci...!!...................DC
Bonjour,
Je me permet de répondre à nouveau au topic qui date de 2005 car la macro m'intéresse beaucoup.
Je l'ai tester et un peu modifier à ma sauce cependant j'ai un petit problème que je n'arrive pas à corriger.
Quand je sauve mon fichier dans un dossier que j'ai choisi par exemple dans le dossier "Facture", je choisi le dossier "Juillet" et j'enregistre, c'est à ce moment la que mon fichier ne s'enregistre pas dans "Juillet" mais dans le dossier précédent: "Facture".
De plus, il ajoute "Juillet" au début du nom de mon fichier, est-ce que vous avez la solution ?
Voici la macro:
'--------------------------------
Sub SaveAs3()
Dim Chemin As String
Dim Fichier As String
Chemin = "C:UsersxxxxDesktopxxxxFacture" 'A renseigner
Fichier = Range("J5") & " - " & Range("H11")
If Right(Fichier, 4) <> ".XLSM" Then
Fichier = Fichier & ".xlsm"
End If
Chemin = ChoixDossier(Chemin)
If Chemin <> "" Then
If MsgBox("Votre fichier sera enregistrer là : " & _
vbCrLf & vbCrLf & Chemin & "" & Fichier & vbCrLf & vbCrLf & _
"Désirez-vous continuez?", _
vbYesNo + vbInformation, "Enregistrer sous") = vbYes Then
ThisWorkbook.SaveAs Chemin & "" & Fichier
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
End Sub
'----------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
If objFolder Is Nothing Then
ChoixDossier = ""
Else
ChoixDossier = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function
'----------------------------------
Bien à vous,
Twikii.