Code Sauvegarde a Modifier

[MuscatMimi]

Bonsoir a tous le Forum

Avec le Code du fichier joint j'aimerais pouvoir Créer un "Dossier" avec le "Nom de la cellule B1"

Puis sauvegarder le Classeur Sous le nom de La cellule B1 & B2 & B3 & B4 & B5

en ayant un espace entre chaque mot Exemple "Denis Fact 104/2009 Cde 2009/104.xls,
dans ce Fichier les explication y sont notifiées

Merci de votre aide précieuse

Cordialement

 

[kjin]

Re : Code Sauvegarde a Modifier

Bonsoir,
Tu ne peux pas utiliser "/" ou "\" dans un nom de fichier (eh oui je sais que tu le sais 😉)
Euh, pour moi, le nom est en B2 et non B1

Sub enregistrer_classeur()
Dim i As Byte, Nom As String, Fichier As String
For i = 2 To 6
Nom = Nom & Cells(i, 2) & " "
Next
Fichier = ActiveWorkbook.Path & "\" & Trim(Nom) & ".xls"
If Dir(Fichier) <> "" Then
MsgBox "le fichier existe déjà !"
Exit Sub
End If
ActiveWorkbook.SaveAs Fichier

End Sub

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Salut Kjin

Mon sauveur
Merci pour ce code,mais j'ai demandé s'il serait possible de créer un dossier
avec comme Nom la cellule B2 etc....... relis ma demande

a+++++++++ kjin

 

[kjin]

Re : Code Sauvegarde a Modifier

Re,
Ah bin oui, j'avais point vu !

Sub enregistrer_classeur()
Dim i As Byte, Nom As String, Rep As String, Fichier As String
For i = 2 To 6
Nom = Nom & Cells(i, 2) & " "
Next
Rep = ActiveWorkbook.Path & "\" & Cells(2, 2).Value
If Dir(Rep, vbDirectory) = "" Then MkDir Rep
Fichier = Rep & "\" & Trim(Nom) & ".xls"
If Dir(Fichier) <> "" Then
MsgBox "le fichier existe déjà !"
Exit Sub
End If
ActiveWorkbook.SaveAs Fichier
End Sub

J'ai crois comprendre que c'est un sous dossier du répertoire courant
A+
kjin

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Salut Kjin

Oui c'est un sous dossier du répertoire

Par contre j'ai oublié de mentionner, qu'il faut n'enregistrer que la Feuil1(par exemple), sans le Code
Fermer le classeur créé, mais laisser classeur actif ouvert
Tu m'avait fait déja une réponse a ce sujet il y a qq mois, mais imposible de retrouver ce code,j'ai du l'enregistrer la ou il ne faut pas

En revenant a ton code ci-desus, tu a fait une boucle sur les cell B2:B7

je viens d'essayer en nomment, des cellule diverses(a la place de la boucle) , mais j'y arrive pas (exemple Cel A1, Cel D5, Cell I2,CelE5,Cel J4,Cel C8)

grand merci pour ton aide

Depuis qq temps, a chaque fois que je suis aidé par une
personne de Xld, je le nomme dans le ou les codes proposé,
et mentionne aussi dans le fichier que je l'ai réalisé avec l'aide de Xld

Bonne journée
Cdlt

 

[kjin]

Re : Code Sauvegarde a Modifier

Bonjour,
Faut dormir la nuit...! 😀
Comment veux tu faire une boucle avec des adresses de cellules aléatoires ?!
Si tu boucles sur les lignes de 1 à 10, l'ordre sera toujours recpecté 1, 2, 3..., au mieux tu peux spécifier de sauter 1 ligne voire plus 1, 3, 5...
Pour les colonnes, il faudrait créer une seconde boucle, mais là encore, impossible de passer de la colonne 4 à la colonne 1 puis colonne 3...
Dans ton premier exemple, tes données étaient en B2:B6, soit ligne 2 à 6 de la colonne2, et c'est pour ça que j'ai pu opté pour la boucle.
Si, comme tu le demandes, tu dois utiliser A1, D5, I2, E5, J4, C8, il n'y a pas d'autre solution que d'écrire l'adresse des cellules.

Sub enregistrer_classeur()
Dim Nom As String, Rep As String, Fichier As String
Nom = Range("A1") & " " & Range("D5") & " " & Range("I2") & " " & _
        Range("E5") & " " & Range("J4") & " " & Range("C8")
Rep = ActiveWorkbook.Path & "\" & Range("A1").Value
If Dir(Rep, vbDirectory) = "" Then MkDir Rep
Fichier = Rep & "\" & Nom & ".xls"
If Dir(Fichier) <> "" Then
    If MsgBox("le fichier existe déjà !" & vbCrLf & "Le remplacer ?", vbYesNo) = vbNo Then
    Exit Sub
    Else: GoTo Enregistrer
    End If
Else: GoTo Enregistrer
End If

Enregistrer:
    Sheets("feuil1").Copy
    With ActiveWorkbook
        With .VBProject.VBComponents(Sheets("feuil1").CodeName).CodeModule
            .DeleteLines 1, .CountOfLines
        End With
        Application.DisplayAlerts = False
        .SaveAs Fichier
        .Close
        Application.DisplayAlerts = True
    End With
        
End Sub

Il faudra également supprimer les boutons copiés, s'il y en a
A+
kjin

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Bonsoir Kjin

Parfait super, comme a l'habitude, grand merci,
Je viens d'essayer, ça fonctionne bien
maintenet faut que je trouve le code pour supprimer
deux Bouton

Bonne nuit
Cordialement

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Salut kjin

Je galére depuis qq heures, pour arrivé a modifier le MsgBox de vérification
de l'existance du Fichier

J'aimerais avoir ce même Msgbox mais sans OUI, et sans NON
Juste le Texte du message et cliquer sur un Btn, afin d'ouvrir le Dossier ou ce trouve le Fichier Source Excel (pas celui que l'on désire créer)

Cordialement

 

[kjin]

Re : Code Sauvegarde a Modifier

Bonsoir,
Ouvrir une boite, soit, mais à quelle fin ? On saurait de quel type de boite il s'agit.
Sans précision difficile de te répondre
A+
kjin

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Bonjour Kjin


Pour une premiére facturation, le Dossier est créé, sous le nom du client,et sa facture est Enregistrée dans ce Dossier
Le but,du MsgBox,+ Ouvrir Enregistrer-Sous, sur le Dossier du Fichier source
et bien si tu facture a nouveau a ce Client ('Toto), il faut que la Nouvelle Facture puisse être Enregistrée dans le Dossier Toto
D'ou ,ouvrir Enregistrer-sous, pour allez chercher le Dossier de ce client afin d'y
enregistrer, cette nouvelle facture
Je ne vois pas mieux a faire
A moins qu'Excel, puisse reconnaitre le Nom de ce client dans la Cellule A1
et ouvrir vraiment sur son Dossier ,
ou ,comme je saisie cette facture via un Usf, qu'Excel aussi reconnaisse le Nom de ce client dans la Cbx "NomClient"

Liens vers ce Fichier
Cijoint.fr - Service gratuit de dépôt de fichiers

ou s'inspirer du fichier joint en utilisant le chemin du Fichier Excel a son Enregistrement,la je sais pas, jette un oeil a ce Fichier

Voila ce que j'ai réalisé, ne te moque pas
et ça fonctionne

Sub enregistrer_classeur()
Dim Nom As String, rep As String, Fichier As String
Nom = Range("B1") & " " & Range("B2") & " " & Range("B3") & " " & _
Range("B4") & " " & Range("B5") & " " & Range("B7")
rep = ActiveWorkbook.Path & "\" & Range("B1").Value
If Dir(rep, vbDirectory) = "" Then MkDir rep
Fichier = rep & "\" & Nom & ".xls"
If Dir(Fichier) <> "" Then
rep = MsgBox("le fichier existe déjà !" & vbCrLf & "Le remplacer ?", vbYesNo) ' = vbNo Then
Select Case rep
Case vbYes
Sauvegarde ' Exit Sub
Case vbNo
' Else: GoTo Enregistrer
'End If
'Else: GoTo Enregistrer
End Select
End If

Sub Sauvegarde()
Application.Dialogs(xlDialogSaveAs).Show ("C:\Documents and Settings\Christian\Bureau\Nouveau dossier")
End Sub

Voila cher Kjin ai-je été clair???
Bonne journée

Cordialement

 

[kjin]

Re : Code Sauvegarde a Modifier

Bonjour,
Je pense que tu t'es trompé de fichier...
Là je n'y comprends plus rien et je crois que tu n'as pas testé le dernier code fourni.
Le voici à nouveau avec les commentaires

Sub enregistrer_classeur()
Dim Nom As String, Rep As String, Fichier As String
'la variable Nom et la concaténation des cellules A1,D5,I2,E5,J4,C8 (ouf !)séparées
'par un espace
Nom = Range("A1") & " " & Range("D5") & " " & Range("I2") & " " & _
        Range("E5") & " " & Range("J4") & " " & Range("C8")
'la variable Rep est contenu de la cellule A1 (nom du client) précédé du chemin
'd'accès au classeur actif
Rep = ActiveWorkbook.Path & "\" & Range("A1").Value
'On teste si dans le répertoire courant il existe un sous-répertoire Rep
's'il n'existe pas, on le crée (donc on teste si le dossier du client existe)
If Dir(Rep, vbDirectory) = "" Then MkDir Rep
'va variable fichier est le chemin vers le dossier du client suivi du nom du fichier
'à créer
Fichier = Rep & "\" & Nom & ".xls"
'on teste si par hasard ce fichier existe déjà au cas ou le dossier du client avait
'était créé antérieurement.C'est peut-être pas utile, mais ça ne mange pas de pain !
'(évidemment, s'il s'agit d'un nouveau dossier, le fichier n'existe pas)
If Dir(Fichier) <> "" Then
    's'il existe déjà, donc cela veut dire qu'il existe déjà un sous-dossier Rep
    '(donc au nom de ce client) contenant un fichier Nom (le fichier à créer)
    'on affiche une boîte demandant s'il faut le remplacer ou non
    If MsgBox("le fichier existe déjà !" & vbCrLf & "Le remplacer ?", vbYesNo) = vbNo Then
    'si tu réponds non, on quitte la procédure
    Exit Sub
    'sinon on se branche sur l'étiquette de ligne enregistrer plus bas
    'qui écrasera le fichier éxistant
    Else: GoTo Enregistrer
    End If
'si le fichier n'existe pas on se branche sur l'étiquette de ligne enregistrer plus bas
Else: GoTo Enregistrer
End If
'Etiquette enregistrer
Enregistrer:
    'on crée une copie de la feuille nommée feuil1 dans un nouveau classeur
    Sheets("feuil1").Copy
    'dans ce nouveau classeur
    With ActiveWorkbook
        'on supprime les lignes de code se trouvant dans la feuille nommée feuil1
        With .VBProject.VBComponents(Sheets("feuil1").CodeName).CodeModule
            .DeleteLines 1, .CountOfLines
        End With
        'on désactive les messages d'alerte (cas de l'écrasement du fichier existant)
        Application.DisplayAlerts = False
        'on l'enregistre
        .SaveAs Fichier
        'on le ferme
        .Close
        'on résactive les messages d'alerte
        Application.DisplayAlerts = True
    End With
        
End Sub

Pourquoi vouloir ouvrir la boite de dialogue enregistrer sous ?!
Que le dossier existe ou non, là n'est pas le pb
Par contre, si dans le dossier du client, il existe déjà un fichier du même nom cela veut dire que les valeurs contenues dans les cellules A1,D5,I2,E5,J4,C8 sont identiques, et donc enregistrer ce fichier sous un nouveau nom faussera ton système d'archivage !
Donc soit tu écrases délibéremment le fichier existant, soit c'est au niveau des valeurs des cellules qu'il y a un pb
Pour être plus clair
J'enregistre mes fichiers avec comme nom la cellule A1 contenant successivement 1, 2, 3...j'obtient 1.xls, 2.xls, 3.xls...
Si je saisie à nouveau 1 en A1, soit j'écrase 1.xls, mais si je le renomme 4.xls ça fait désordre parce A1 contiendra 1 !
Ouf 😱
A+
kjin

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Salut Kjin

J'ai testé ton code , il fonctionne bien et j'ai compris ce code

pour le reste c'est bon, j'ai testé, et ça fonctionne

Même "Nom" en A1 et nom différends dans les autres cellules , ça fonctionne,
le nouveau fichier s'enregistre en plus des précédents déja enregistré

Donc ce que j'ai demandé dans mon message précédent s'annul,
j'ai parlé trop vite ,milles excuses,
c'est toi qui a raison

a +++++Kjin

 

[kjin]

Re : Code Sauvegarde a Modifier

Re,

J'ai testé ton code , il fonctionne bien et j'ai compris ce code

Je vais manger mon chapeau 😱
Reprenons :
En A1
- le nom du client, "toto"
les autres cellules on s'en fout disons simplement qu'elles indiquent
- un N° de facture, 1 par exemple
- une date 30-08-09, par exemple
J'obtiens donc un fichier "toto 1 30-08-09.xls"
Ce que fait la macro :
- le dossier "toto" n'existait pas encore donc il est créé
- elle vérifie que le fichier n'existe pas dans le dossier "toto", mais comme on vient juste de le créer, il a peu de chance d'exister, donc il est enregistré dans le dossier "toto" nouvellement créé.
Maintenant, je remplace le N° de facture 1 par 2
J'obtiens donc un fichier "toto 2 30-08-09.xls"
Ce que fait la macro :
- le dossier "toto" existe déjà donc on saute l'étape de création de dossier
- elle vérifie que le fichier n'existe pas, et c'est le cas, donc il est enregistré dans le dossier "toto"
Maintenant je mets "loulou" en A1 et 1 pour le N° de facture
J'obtiens un fichier "loulou 1 30*08-09.xls" enregistré dans un nouveau dossier nommé "loulou"
Maintenant je mets "toto" en A1 et 1 pour le N° de facture
J'obtiens donc un fichier "toto 1 30-08-09.xls"
Ce que fait la macro :
- le dossier "toto" existe déjà donc on saute l'étape de création de dossier
- elle vérifie que le fichier n'existe pas, et là oh surprise il existe déjà !
Alors si tu réponds oui à remplacer dans le message d'alerte, l'ancien fichier sera écrasé par le nouveau, sinon la macro s'arrête, ce qui te permettra d'allez voir pourquoi tu as 2 fois le même N° de facture pour un même client !

Maintenant, je n'ai peut-être rien compris à ta demande et je passe la main

Edit : je viens seulement de m'apercevoir que tu as modifié ton message pendant mon absence et je n'avais pas raffraichi !
Ravi de voir que nous sommes d'accord

A+
kjin

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Re Kjin

oui tu a raison, si j'avais bien testé je serais arrivé a ta conclusion
c'est moi qui a déconné dans mes explications
pardon Kjin

A tu vu le fichier comparateur de Prix???
réalisé par moi-même avec l'aide des personnes, (tu en fait partie)
de ExcelDownload

Par contre une question qui me viens a l'esprit, concernant un fichier "Compe bancaire, terminé,mais dans lequel, j'aimerais savoir s'il serait possible de pouvoir gérer plusieurs utilisateur avec le même fichier,et que chaque utilisateur ai un mot de passe ,pour n'accéder qu'au données de son Compte, si tu veux regarder je peux te le passer

allez A+++++

 

[MuscatMimi]

Re : Code Sauvegarde a Modifier

Bonsoir Kjin,

ben oui encore moi

Regarde la copie ecran,ci-joint
MsgBox pris sur un fichier que j'avais en stock
Dis-moi si l'on peux imcorporer ce MsgBox dans le Code que tu m'a fait??,

Bonne soirée