Ouvrir un dossier après l'avoir creé

Le 22/08/2019 à 11:21

bonjour à tous,

je viens juste de m'inscrire sur ce forum où j'ai déjà prélevé pas mal de morceaux de codes, ce qui prouve la qualité des personnes qui en font parties.

je suis plus que novice dans le domaine de la macro, et je vous pris d'excuser par avance les bourdes que je vais faire.

voici mon problème:

j'ai récupéré un code sur le forum qui me cherche un dossier et un sous dossier, s'il n'existe pas il est créé (cela marche très bien).

par contre je n'arrive pas à trouver le morceau de code qui me permet de l'ouvrir lorsqu'il l'a trouvé. je planche dessus depuis trois jours sans résultat (je jette ma bouteille à la mer en espérant que quelqu'un la trouvera).

merci d'avance

JDMR

voici le code:

Sub vérif_dossierAnnee()

Chemin = ThisWorkbook.Path

Chemin = ThisWorkbook.Path & "\" & CStr(Year(Date)) 'chemin accès du fichier "cahier de quart 2X8"

If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin

Chemin = Chemin & "\" & Format(Month(Date), "00")

If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin

End Sub

Le 22/08/2019 à 12:06

Bonjour,

On n'ouvre pas un dossier : On ouvre un classeur.

Que veux tu y faire au dossier que tu as créé ?

A+

Le 22/08/2019 à 14:07

bonjour galopin01,

désolé pour l'erreur,

c'est un classeur d'archivage.

J'ai un classeur "cahier de quart" où je crée chaque jour une nouvelle feuille par un bouton avec la date du jour dans l'onglet.

Afin de l’alléger je voudrai transférer les feuilles les plus anciennes dans mon classeur d'archivage où se trouve un classeur par année (ex. 2019), l'année prochaine (2020).

J'ai trouvé une macro pour transférer les journées dans un classeur si je le nomme explicitement (sauf que les personnes utilisatrices ne peuvent pas le faire), d'où mon idée de vérifier avec une macro si un classeur "archive" de l'année existe, le créer s'il n'existe pas et transférer les feuilles par un bouton selon leur convenance. En 2020 la manip sera la même ainsi que chaque année.

merci pour ta réponse rapide (je pense que tu va me reprendre souvent sur des appellations ou autres, (c'est comme ça que j'apprends le mieux) .

Le 22/08/2019 à 17:11

Le mieux ça serait que tu me donne ta macro qui te sert à faire l'archivage... Mebon !

Je te propose de modifier ta macro précédente en Function et ta macro d'archivage sur le modèle suivant :

Option Explicit

Function isOkDirArc()
Dim chemin$
   chemin = ThisWorkbook.Path
   chemin = ThisWorkbook.Path & "\" & Year(Date)
   If Dir(chemin, vbDirectory) = "" Then MkDir chemin
   chemin = chemin & "\" & Format(Month(Date), "00")
   If Dir(chemin, vbDirectory) = "" Then MkDir chemin
   isOkDirArc = True
End Function

Sub Archivage()
 If isOkDirArc Then
 'Longue suite d'instructions pour l'archivage des données...

 MsgBox "Archivage effctué"
 Else
   MsgBox "Erreur en création du dossier"
 End If
End Sub

Nota : J'ai mis le :

 Else
   MsgBox "Erreur en création du dossier"

...pour la route et pour ta bonne compréhension mais cette situation ne peut jamais se présenter !

A+

Le 22/08/2019 à 17:33

merci galopin01,

je vais l'essayer et la décortiquée demain matin,

merci pour ton retour ultra rapide.

JDMR

Le 23/08/2019 à 11:24

bonjour à tous,

le code de galopin01 fonctionne bien.

je viens de passer ma matinée à essayer de l'incorporer avec mon code d'archivage et je me tape la tête contre les murs car je n'arrive pas à enregistrer dans le nouveau classeur créé (manque de connaissance de ma part).

je joins les macros que j'ai réalisées pour ma sauvegarde (attention, il y a des chances qu'elles vous piquent les yeux).

merci pour l'aide que vous pourrez m'apporter

jdmr

Sub archives()

Application.ScreenUpdating = False

'demande de s'assurer de son action

If MsgBox("Archivage feuille par feuille" & Chr(10) & Chr(10) & "Voulez-vous continuer?", vbYesNo) = vbNo Then

Exit Sub

End If

' je suis obligé de nommer explicitement le classeur pour la sauvegardeouverture du dossier archive cahiers CDE

Workbooks.Open Filename:= _

"M:\08_Incineration\08_01_Echange\Archives cahier de quart\Archives 2X8 cahier de quart\cahier CDE 2019\cahier CDE 2019 archive.xlsx" _

, UpdateLinks:=0

'j'appele une macro 'Archivage"

Call Archivage

Application.DisplayAlerts = False

'fermeture du dossier "archive"

Workbooks("cahier CDE 2019 archive.xlsx").Close SaveChanges:=True

End Sub

Sub Archivage()

'cahier de quart 2X8 ouvert

Windows("cahier de quart 2X8.xlsm").Activate

'nombre de feuille à archiver

a = 1

b = 1

For i = b To a Step -1

'je transfert la feuille sélectionnée dans le classeur d'archive

Sheets(i).Move after:=Workbooks("cahier CDE 2019 archive.xlsx"). _

Sheets(1)

'sélection d'une nouvelle feuille ou sortie

Next i

If MsgBox("prochaine feuille", vbYesNo) = vbYes Then

Call Archivage

End If

End Sub[/size][/size]

Le 26/08/2019 à 11:57

bonjour à tous,

j'ai réussi à comprendre comment mettre mon code concernant l'archivage dans le message, (cela fait un peu plus sérieux, mais ça montre aussi mon niveau).

merci de prendre de votre temps pour m'aider sur ce sujet.

je souhaite archiver des feuilles dans un classeur au nom de l'année, le créer s'il n'existe pas et faire cela chaque année.

les personnes utilisatrices sont encore moins performantes que moi et je souhaiterai qu'elles le fasse par un bouton .

merci d'avance

JDMR

Sub archives()

Application.ScreenUpdating = False
'demande de s'assurer de son action
If MsgBox("Archivage feuille par feuille" & Chr(10) & Chr(10) & "Voulez-vous continuer?", vbYesNo) = vbNo Then
Exit Sub
End If

' je suis obligé de nommer explicitement le classeur pour la sauvegardeouverture du dossier archive cahiers CDE
Workbooks.Open Filename:= _
        "M:\08_Incineration\08_01_Echange\Archives cahier de quart\Archives 2X8 cahier de quart\cahier CDE 2019\cahier CDE 2019 archive.xlsx" _
        , UpdateLinks:=0

 'j'appele une macro 'Archivage"

 Call Archivage

Application.DisplayAlerts = False
'fermeture du dossier "archive"
Workbooks("cahier CDE 2019 archive.xlsx").Close SaveChanges:=True

End Sub
Sub Archivage()

'cahier de quart 2X8 ouvert

Windows("cahier de quart 2X8.xlsm").Activate

'nombre de feuille à archiver
a = 1
b = 1

For i = b To a Step -1

'sélection d'une nouvelle feuille ou sortie
Next i

 If MsgBox("prochaine feuille", vbYesNo) = vbYes Then

 Call Archivage

 End If

End Sub
Le 26/08/2019 à 17:09

Ça on peut pas le faire à ta place ! Vu qu'il n'y que toi qui a le classeur; c'est pas bien sorcier de mettre un bouton (Dans l'onglet développeur > Insérer), ou une forme quelconque dans l'onglet Insertion > Illustration > Formes tu choisis une forme qui te va bien puis tu fais un clic droit dessus puis affecter une macro...

insbutton

C'est plus facile avec l'onglet Insertion...

A+

Le 27/08/2019 à 09:14

bonjour galopin01,

merci pour ta réponse,

en voulant expliquer ce que je voulais faire, je n'ai pas été très clair, je sais créer les boutons et leur affecter une macro(je ne peux pas être mauvais dans tout).

je suis resté sur ton code de recherche et création d'un dossier (qui fonctionne), mais je n'ai pas réussi à incorporer mes codes d'archivage pour que l'ensemble fonctionne, d'où mon explication de ce que je souhaitais faire:

j'ai créé un cahier "cahier de quart " qui est utilisé tous les jours.

grâce à une macro je crée une nouvelle feuille chaque jour en nommant l'onglet "dd mmm", pour 20 jours travaillés cela me fait 20 feuilles.

je veux archiver ces feuilles en les déplaçant dans un classeur "année "voir si possible "mois", lorsque je le souhaite afin d’alléger le cahier.

en dessous les codes dont je me sert pour archiver et qui me posent un problème car je suis obligé de nommer explicitement le chemin (les personnes utilisatrices ne seront pas faire ce genre de chose).

j'espère que j'ai été assez clair.

JDMR

Sub archives()

Application.ScreenUpdating = False
'demande de s'assurer de son action
If MsgBox("Archivage feuille par feuille" & Chr(10) & Chr(10) & "Voulez-vous continuer?", vbYesNo) = vbNo Then
Exit Sub
End If

' je suis obligé de nommer explicitement le classeur pour la sauvegardeouverture du dossier archive cahiers CDE
Workbooks.Open Filename:= _
"M:\08_Incineration\08_01_Echange\Archives cahier de quart\Archives 2X8 cahier de quart\cahier CDE 2019\cahier CDE 2019 archive.xlsx" _
, UpdateLinks:=0

'j'appele une macro 'Archivage"
Call Archivage

Application.DisplayAlerts = False
'fermeture du dossier "archive"
Workbooks("cahier CDE 2019 archive.xlsx").Close SaveChanges:=True

End Sub
Sub Archivage()
'cahier de quart 2X8 ouvert
Windows("cahier de quart 2X8.xlsm").Activate

'nombre de feuille à archiver
a = 1
b = 1

For i = b To a Step -1
'je transfert la feuille sélectionnée dans le classeur d'archive
Sheets(i).Move after:=Workbooks("cahier CDE 2019 archive.xlsx"). _
Sheets(1)

'sélection d'une nouvelle feuille ou sortie
Next i

If MsgBox("prochaine feuille", vbYesNo) = vbYes Then

Call Archivage

End If

End Sub
Le 27/08/2019 à 18:26

Il y a quand même quelques problèmes :

Malheureusement je ne travaille pas sur boule de cristal...

Tu comptes résoudre ton archivage avec move : Or move supprime la feuille.

Sauf que on ne peut pas supprimer toutes les feuilles du classeur d'origine.

Donc j'ai un gros problème si tu introduis :

'nombre de feuille à archiver
a = 1
b = 1
For i = b To a Step -1

Ça moi je sais pas faire : J'ai besoin d'être certain de ce qui sera supprimé pour être certain qu'il restera au moins une feuille visible dans ton classeur. En plus travailler avec un index me semble pas bon du tout...

Donc il faut me dire comment tu comptes résoudre ce problème pour que je puisse terminer...

Une solution serait de créer dans ce classeur une feuille "Accueil" qui serait toujours la première (ou toujours la dernière) Ainsi on pourrai archiver toutes celles qui ne s'appellent pas "Accueil"

Qu'en pense tu ?

A+

Le 27/08/2019 à 21:39

merci de me consacrer de ton temps,

oui dans mon classeur archive j'ai créé une feuille que j'ai pris comme référence et que j'ai appelé dans la macro "sheets 1"

a+

JDMR

Le 27/08/2019 à 21:58

M'en fiche du classeur archive c'est le classeur de travail que tu vas vider de toutes ses feuilles !

Les macro suivantes déplacent toutes les feuilles dans le classeur d'archivage :

Option Explicit
Dim chemin
Function WayOffArc$()
   chemin = ThisWorkbook.Path
   chemin = chemin & "\cahier CDE " & Year(Date)
   If Dir(chemin, vbDirectory) = "" Then MkDir chemin
   chemin = chemin & "\" & Format(Month(Date), "00")
   If Dir(chemin, vbDirectory) = "" Then MkDir chemin
   WayOffArc = chemin
End Function

Sub Archivage()
'demande de Confirmation
   If MsgBox("Archivage de toutes les feuilles" & Chr(10) & Chr(10) & Space(6) & _
   "Voulez-vous continuer?", vbYesNo + vbCritical, "CONFIRMATION") = vbYes Then Galopin
End Sub

Sub Galopin()
   Dim i%, k%, WbS As Workbook
   Set WbS = ThisWorkbook
   k = WbS.Worksheets.Count 'nombre de feuille à archiver
   chemin = WayOffArc
   Application.ScreenUpdating = False
   On Error GoTo GESTERR
   Workbooks.Open Filename:=chemin & "\" & "archive.xlsx", UpdateLinks:=0
   For i = k To 1 Step -1
         If Not WbS.Worksheets(i).CodeName = "WsA" Then
            WbS.Worksheets(i).Move before:=ActiveWorkbook.Worksheets(1)
      End If
   Next i
   Application.DisplayAlerts = False
       ActiveWorkbook.Save
       ActiveWorkbook.Close
   MsgBox "Archivage effctué"
   Exit Sub
GESTERR:
   Select Case Err
   Case 1004
      Workbooks.Add
      ActiveWorkbook.SaveAs Filename:=chemin & "\" & "archive.xlsx", _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      Resume Next
   Case Else
      MsgBox "Erreur non gérée"
   End Select
End Sub

A partir de ThisWorkbook.Path elles créent un sous dossier "cahier CDE + Année en cours"

A l'intérieur de ce dossier elle crée un sous dossier "mois en cours"

Enfin la macro galopin crée ou modifie l'archive.

Important : L'archivage supprime toutes les feuilles du classeur de travail sauf une

Comme je ne sais pas laquelle sera choisie, dans VBA faites F4 pour afficher la fenêtre des propriétés.

Dans l'explorateur de projet Double cliquez sur la feuilles qui ne sera jamais archivée puis dans la fenêtre des propriétés renommez là "WsA"

codename2

A+

Le 28/08/2019 à 12:52

bonjour, et désolé pour la mauvaise réponse ,

dans mon classeur actif je garde toujours une feuille prototype qui me sert à créer chaque jour la journée , il n'est jamais vide.

les autres feuilles je les enlève du classeur selon ma volonté, c'est pour cette raison que je les déplace.

Le 29/08/2019 à 08:22

merci galoipin01 pour la macro que tu as réalisé,

je l'ai essayée et elle fonctionne un peu trop bien.

j'avoue que ce que tu as réalisé j'étais incapable de le faire.

si je peux encore abuser de ton savoir, je souhaiterai pouvoir archiver feuille par feuille plus tôt que toutes les feuilles ensembles.

je vais regarder de mon coté comment faire.

merci encore une fois.

JDMR

Le 29/08/2019 à 09:17

Dans ce cas je t'en fais 2 pour le prix d'une ! On garde la fonction et on réunit la sub Archivage et la Sub Galopin :

Sub Archivage()
Sub Galopin()
   Dim i%, k%, WbS As Workbook
   Set WbS = ThisWorkbook
   k = WbS.Worksheets.Count 'nombre de feuille à archiver
   chemin = WayOffArc
   Application.ScreenUpdating = False
   On Error GoTo GESTERR
   Workbooks.Open Filename:=chemin & "\" & "archive.xlsx", UpdateLinks:=0
   For i = k To 1 Step -1
         If Not WbS.Worksheets(i).CodeName = "WsA" Then
            If MsgBox("Archivage de la feuille " & Chr(10) & Space(6) & WbS.Worksheets(i).Name & Chr(10) & _
                  "Voulez-vous continuer?", vbYesNo + vbCritical, "CONFIRMATION") = vbYes Then
            WbS.Worksheets(i).Move before:=ActiveWorkbook.Worksheets(1)
            End If
      End If
   Next i
   Application.DisplayAlerts = False
       ActiveWorkbook.Save
       ActiveWorkbook.Close
   MsgBox "Archivage effctué"
   Exit Sub
GESTERR:
   Select Case Err
   Case 1004
      Workbooks.Add
      ActiveWorkbook.SaveAs Filename:=chemin & "\" & "archive.xlsx", _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      Resume Next
   Case Else
      MsgBox "Erreur non gérée"
   End Select
End Sub

A+

Le 29/08/2019 à 17:25

merci galopin01,

c'est tout à fait ce que je voulais faire.

j'ai un petit travail d'adaptation à réaliser qui est une formalité grâce à la qualité de ton travail. j'avoue que j'étais loin de ce résultat.

JDMR

Rechercher des sujets similaires à "ouvrir dossier cree"