eregistrement sous dans dossier spécifique

[marc21]

Bonjour a vous tous,
Pouvez vous m'aider, je suis bloquer pour un code d'enregistrement sous, j'aimerais, suivant un choix dans un listing, que l'enregistrement sous se fasse suivant le choix du listing, donc à placer le fichier dans le bon dossier suivant le choix exemple : si je choisi le dossier un , lors de l'enregistrement sous, je veux qu'il se place dans le c:/chiffres/un, et que si je choisis deux je veux qu'il se place dans le c:/chiffres/deux, etc....


merci d'avance votre aide


Marc21

 

[@+Thierry]

Bonjour Marc, le Forum

En partant de ton fichier, voici ce que ça donnerait en VBA :

Option Explicit

Const Path1 As String = "c:\chiffres\Un\"
Const Path2 As String = "c:\chiffres\Deux\"
Const Path3 As String = "c:\chiffres\Trois\"
Const Path4 As String = "c:\chiffres\Quatre\"
Const Path5 As String = "c:\chiffres\Cinq\"

Sub SaveAsSpecicPath()
Dim FileName As String
Dim ThePath As String

If Range("E20") = "" Or Range("E13") = "" Then Exit Sub

FileName = Range("E20")

    Select Case Sheet1.Range("E13")
        Case 1: ThePath = Path1
        Case 2: ThePath = Path2
        Case 3: ThePath = Path3
        Case 4: ThePath = Path4
        Case 5: ThePath = Path5
    End Select

ThisWorkbook.SaveAs ThePath & FileName


End Sub

Bon Appétit
@+Thierry

 

[marc21]

merci a toi , j'essaye ton aide et l'adapte pour mon fichier
merci
Marc21

 

[marc21]

Je dois envoyer le fichier dans deux lecteurs différents, sur mon essais, j'avais omis de dire que lors du choix dans le listing, la valeur de référence était sur une autre page "Présentation" et que la cellule était : a100
Peux tu me corriger les erreurs ou bien c'est comme cela que je dois faire suivant ton aide reçue.
Merci
Marc21

Option Explicit

Const Path1 As String = "r:\ARCHIVES OCS\OCS un\"
Const Path2 As String = "r:\ARCHIVES OCS\OCS deux\"
Const Path3 As String = "r:\ARCHIVES OCS\OCS trois\"
Const Path4 As String = "r:\ARCHIVES OCS\OCS quatres\"
Const Path5 As String = "r:\ARCHIVES OCS\OCS Cinq\"

Const Path6 As String = "e:\ARCHIVES OCS\OCS un\"
Const Path7 As String = "e:\ARCHIVES OCS\OCS deux\"
Const Path8 As String = "e:\ARCHIVES OCS\OCS trois\"
Const Path9 As String = "e:\ARCHIVES OCS\OCS quatres\"
Const Path10 As String = "e:\ARCHIVES OCS\OCS Cinq\"

Sub SaveAsSpecicPath()
Dim FileName As String
Dim ThePath As String
Dim ThePath1 As String

If Range("E20") = "" Or Range("E13") = "" Then Exit Sub

FileName = Range("E20")

Select Case Sheet1.Range("E13")
Case 1: ThePath = Path1
Case 2: ThePath = Path2
Case 3: ThePath = Path3
Case 4: ThePath = Path4
Case 5: ThePath = Path5
Case 6: ThePath1 = Path6
Case 7: ThePath1 = Path7
Case 8: ThePath1 = Path8
Case 9: ThePath1 = Path9
Case 10: ThePath1 = Path10

End Select

ThisWorkbook.SaveAs ThePath & FileName
ThisWorkbook.SaveAs ThePath1 & FileName

End Sub

Merci de votre aide

 

[@+Thierry]

Aie Marc

Tu aurais dû préciser dès le départ que tu pouvais changer de lecteur...

Je pense qu'il faut passer par un statement "ChDrive" et par conséquent çà va un peu compliquer le code...


Option Explicit

Const Path1 As String = ":\ARCHIVES OCS\OCS un\"
Const Path2 As String = ":\ARCHIVES OCS\OCS deux\"
Const Path3 As String = ":\ARCHIVES OCS\OCS trois\"
Const Path4 As String = ":\ARCHIVES OCS\OCS quatres\"
Const Path5 As String = ":\ARCHIVES OCS\OCS Cinq\"

Sub SaveAsSpecicPath()
Dim FileName As String
Dim ThePath As String
Dim CurDrive As String

CurDrive = Left(CurDir, 1)

If Sheets("FeuilleLaOuEstLeNom").Range("E20") = "" Or Sheets("Présentation").Range("A100") = "" Then Exit Sub

FileName = Sheets("FeuilleLaOuEstLeNom").Range("E20")

    Select Case Sheets("Présentation").Range("A100")
        Case 1: ThePath = Path1
        Case 2: ThePath = Path2
        Case 3: ThePath = Path3
        Case 4: ThePath = Path4
        Case 5: ThePath = Path5
    End Select

With ActiveWorkbook
    ChDrive "R"
    .SaveCopyAs "R" & ThePath & FileName
    ChDrive "E"
    .SaveCopyAs "E" & ThePath & FileName
    .Close False
End With

ChDrive CurDrive

End Sub


Ici je propose de faire des copies du fichier avec "SaveCopyAs"... Je supose aussi que tu as Exactement le même cheming sur les deux lecteurs... (Sinon faudra encore adapter...)

Bonne fin de Journée
@+Thierry

 

[marc21]

merci de ton aide,

si le chemin est différent, comment faudra t'il procédé ?,
car je ne suis plus au travail pour l'instant. et je ne saurais pas testé maintenant.
Si par exemple il y a un dossier de plus avant de mettre dans le dossier defini exemple :
Const Path1 As String = ":\ARCHIVES OCS\OCS un\" pour le R

Const Path1 As String = ":\Dossier 2005\OCS SAUVEGARDE\OCS un\" pour le E

Comme tu l'as marqué, je suppose qu'il faut adapter d'une autre manière

encore merci thierry

 

[@+Thierry]

Re Bonsoir Marc, le Forum

Il y a toujours un truc qui me chagrine, pourquoi quand les gens postent des exemples, ils ne pensent jamais à exposer leur problème réél complet en entier... Le Coup des Lecteurs, puis maintenant le coup des Chemins qui étaient bien les mêmes dans ton précédent post... Ce n'est pas grave, mais en tant que développeur on est tout le temps confronté à ce genre de fossé entre les Utilisateurs...

Bon t'inquiète pas, je ne t'en veux pas, mais c'est juste une constatation...

J'espère que ce coup-ci sera le bon :

Option Explicit

Const Path1 As String = "R:\ARCHIVES OCS\OCS un\"
Const Path2 As String = "R:\ARCHIVES OCS\OCS deux\"
Const Path3 As String = "R:\ARCHIVES OCS\OCS trois\"
Const Path4 As String = "R:\ARCHIVES OCS\OCS quatres\"
Const Path5 As String = "R:\ARCHIVES OCS\OCS Cinq\"
Const Path6 As String = "E:\Dossier 2005\OCS SAUVEGARDE\OCS un\"
Const Path7 As String = "E:\Dossier 2005\OCS SAUVEGARDE\OCS deux\"
Const Path8 As String = "E:\Dossier 2005\OCS SAUVEGARDE\OCS trois\"
Const Path9 As String = "E:\Dossier 2005\OCS SAUVEGARDE\OCS quatres\"
Const Path10 As String = "E:\Dossier 2005\OCS SAUVEGARDE\OCS Cinq\"




Sub SaveAsSpecicPath()
Dim FileName As String
Dim ThePath As String, TheBackUpPath As String
Dim CurDrive As String

CurDrive = Left(CurDir, 1)

If Sheets("FeuilleLaOuEstLeNom").Range("E20") = "" Or Sheets("Présentation").Range("A100") = "" Then Exit Sub

FileName = Sheets("FeuilleLaOuEstLeNom").Range("E20")

    Select Case Sheets("Présentation").Range("A100")
        Case 1: ThePath = Path1: TheBackUpPath = Path6
        Case 2: ThePath = Path2: TheBackUpPath = Path7
        Case 3: ThePath = Path3: TheBackUpPath = Path8
        Case 4: ThePath = Path4: TheBackUpPath = Path9
        Case 5: ThePath = Path5: TheBackUpPath = Path10
    End Select

With ActiveWorkbook
    ChDrive Left(ThePath, 1)
    .SaveCopyAs ThePath & FileName
    ChDrive Left(TheBackUpPath, 1)
    .SaveCopyAs TheBackUpPath & FileName
    .Close False
End With

ChDrive CurDrive

End Sub

Bonne Soirée
@+Thierry

 

[marc21]

je te remercie,
il vrai, que l'on ne connais pas tout et comme j'avais essayer un bout encore un peu plus loin, et , personnellemnt, j'aime bien avancé, mais c'est chaque fois au cours de l'évolution d'un petit programme , tiens, je mettrai, bien ca en plus et puis ca encore et il est vrai qu'il serait plus facile de donnés toutes les indications pour ma demande d'aide, mais je ne les ait pas toujours au bon moment ,
mais,
mille fois merci de ton aide et du forum, car , j'ai appris beaucoup avec vous tous et j'en apprendrais encore et car , j'en suis encore loin de tes connaissances.

Marc21

 

[marc21]

Merci à @+thierry - enregistrement sous dans dossier spécifique

j'ai essayer tout ce que tu y a placer dans le code,
je te remercie beaucoup, cela fonctione, mais j'ai du placer dans la cellule de concaténation ".xls" sinon , il l'enregistrait sans extension,
Merci à toi de ton aide fructueuse.
Marc21