Apres réflexion je me demande si ce n'est pas plus judicieux d'abandonner le calendrier avec double click dans ( 01 petite sirène ) et avoir dans la cellule date la fonction aujourd'hui tout en gardant la remise a zéro du formulaire des que la date change ?
Bon dans ce cas ... J'ai modifié le code et mis dans la plage DateDuJour la fonction AUJOURDHUI().
Voici la liste des noms définis pour les classeurs distants (Exemple ici 01 PETITE SIRENE)
J'ai modifié la macro de mise à jour, pour lire les données sans ouvrir les fichiers distants :
On écrit une formule du style ='Chemin[classeur]Onglet'!Cellule et on remplace immédiatement la formule par sa valeur.
J'ai placé les paramètres qui étaient dans la macro de mise à jour dans un onglet "Tables" (je trouve cela plus pratique pour la maintenance), je l'ai masqué.
J'ai placé dans un module mdl_Constantes les principales constantes utilisées (modifications en un seul endroit).
Plutôt que de faire un RàZ des données dans tous les fichiers distants (il faut les ouvrir 1 à 1, les modifier, les fermer en enregistrant) , je lis la date contenue dans le fichier (la cellule B9 qui contient =AUJOURDHUI()) et je n'importe les données que si cette date est égale à la date du jour.
Le contenu de l'onglet "Tables" :
J'ai commenté le code pour en facilité l'appropriat Le code de ThisWorkbook (peu de changement)
Enrichi (BBcode):
Private Sub Workbook_Open()
Application.EnableEvents = False
Application.ScreenUpdating = False
'Lance les mises à jour
RàZ_Import
MàJ_Effectifs
'Enregistrement du fichier
Thisworbook.Save
MsgBox "Mise à jour terminée."
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Le code de la feuille "EFFECTIF"
Enrichi (BBcode):
Option Explicit
Private Sub CBn_Import_Click()
RàZ_Import
MàJ_Effectifs
End Sub
Private Sub CBn_RàZ_Import_Click()
RàZ_Import
End Sub
Le module mdl_Constantes
Enrichi (BBcode):
Public Const MdP$ = "UPC-LM22" 'Mot de passe
Public Const CelluleDate$ = "B9" 'Cellule contenant la date dans les fichiers distants
Public Const ColPath% = 1 'Colonne contenant le Chemin
Public Const ColClasseur% = 2 'Colonne contenant le nom du classeur
Public Const ColOnglet% = 3 'Colonne contenant le nom de l'onglet
Public Const ColLigne% = 4 'Colonne contenant le N° de ligne cible
Le module mdl_AtTheOne
Enrichi (BBcode):
Sub MàJ_Effectifs()
Dim Tb_Fichiers_Source, Tb_Adresses_Source, Tb_Colonnes_Cible, Sh_Cible As Worksheet
Dim lgn As Long, Réf_Ext$, Formule$
'Lecture des paramétres dans les tableaux de la feuille "Tables"
Tb_Fichiers_Source = Sh_Tables.[tb_Fichiers]
Tb_Adresses_Source = Sh_Tables.[tb_Cellules[Source]]
Tb_Colonnes_Cible = Sh_Tables.[tb_Cellules[Colonne Cible]]
Set Sh_Cible = ThisWorkbook.Worksheets(Sh_Tables.[Onglet_Cible].Value)
Sh_Effectif.Protect userinterfaceonly:=True, Contents:=True, Password:=MdP
Application.ScreenUpdating = False
Application.EnableEvents = False
'Boucles sur tous les fichiers source
For i = 1 To UBound(Tb_Fichiers_Source, 1)
Application.StatusBar = Tb_Fichiers_Source(i, 2)
If Dir(Tb_Fichiers_Source(i, ColPath) & Tb_Fichiers_Source(i, ColClasseur)) <> "" Then
'Ligne de l'onglet cible
lgn = Tb_Fichiers_Source(i, ColLigne)
If lgn > 0 Then
'Partie externe de la référence pour cette source (sous la forme 'Chemin[Classeur]Onglet!' )
Réf_Ext = "'" & Tb_Fichiers_Source(i, ColPath) & "[" & Tb_Fichiers_Source(i, ColClasseur) & "]" & Tb_Fichiers_Source(i, ColOnglet) & "'!"
'Date de mise à jour du fichier
Sh_Tables.[Date_Màj].Formula = "=" & Réf_Ext & CelluleDate
'Boucle sur les adresses à importer si la date convient
If Sh_Tables.[Date_Màj] = Date Then
For j = 1 To UBound(Tb_Adresses_Source, 1)
'Référence complète (sous la forme 'Chemin[Classeur]Onglet!'Cellule )
Réf = Réf_Ext & Tb_Adresses_Source(j, 1)
'Formule gérant les cellules vides (pour ne pas avoir de zéro si la cellule lue est vide)
Formule = "=IF(ISBLANK(" & Réf & "),""""," & Réf & ")"
With Sh_Cible.Range(Tb_Colonnes_Cible(j, 1) & lgn)
'Ecriture de la formule
.Formula = Formule
'Remplacement par la valeur trouvée
.Value = .Value
End With
Next
End If
End If
End If
Next
Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub RàZ_Import()
With Sh_Effectif
.Protect userinterfaceonly:=True, Contents:=True, Password:=MdP
.[Zone_Import].ClearContents
End With
End Sub
Voir le fichier en PJ
Voilà, j'espère que cela t'aidera.
Tout d'abord je te remercie d'avoir pris le temps de trouver une solution a mon problème
Pj1 est' il possible que cela ne s'affiche pas a l'ouverture
Pj2 malgré la mise a jour effectuée j'ai ce code erreur qui me donne l'erreur en Pj 3
Dernier point : serait-il possible qu'a l'ouverture du fichier distant cette a dire "01 petite sirène " le tableau se remette a zéro ( chiffre cellule effectif vide ) soit en fonction de la nouvelle date ou simplement avec un bouton "remise a zéro tableau "
que l'utilisateur aura a cliquer
J'ai supprimer la liaison qui traînait ( Date_MàJ dans la l'Onglet "Tables") en remplaçant dans le code, la formule par sa valeur (modif effectuée en gras et en rouge). :
Le module mdl_AtTheOne
Enrichi (BBcode):
Sub MàJ_Effectifs()
Dim Tb_Fichiers_Source, Tb_Adresses_Source, Tb_Colonnes_Cible, Sh_Cible As Worksheet
Dim lgn As Long, Réf_Ext$, Formule$
'Lecture des paramétres dans les tableaux de la feuille "Tables"
Tb_Fichiers_Source = Sh_Tables.[tb_Fichiers]
Tb_Adresses_Source = Sh_Tables.[tb_Cellules[Source]]
Tb_Colonnes_Cible = Sh_Tables.[tb_Cellules[Colonne Cible]]
Set Sh_Cible = ThisWorkbook.Worksheets(Sh_Tables.[Onglet_Cible].Value)
Sh_Effectif.Protect userinterfaceonly:=True, Contents:=True, Password:=MdP
Application.ScreenUpdating = False
Application.EnableEvents = False
'Boucles sur tous les fichiers source
For i = 1 To UBound(Tb_Fichiers_Source, 1)
Application.StatusBar = Tb_Fichiers_Source(i, 2)
If Dir(Tb_Fichiers_Source(i, ColPath) & Tb_Fichiers_Source(i, ColClasseur)) <> "" Then
'Ligne de l'onglet cible
lgn = Tb_Fichiers_Source(i, ColLigne)
If lgn > 0 Then
'Partie externe de la référence pour cette source (sous la forme 'Chemin[Classeur]Onglet!' )
Réf_Ext = "'" & Tb_Fichiers_Source(i, ColPath) & "[" & Tb_Fichiers_Source(i, ColClasseur) & "]" & Tb_Fichiers_Source(i, ColOnglet) & "'!"
'Date de mise à jour du fichier With Sh_Tables.[Date_Màj]
.Formula = "=" & Réf_Ext & CelluleDate
.Value = .Value
End With'Boucle sur les adresses à importer si la date convient
If Sh_Tables.[Date_Màj] = Date Then
For j = 1 To UBound(Tb_Adresses_Source, 1)
'Référence complète (sous la forme 'Chemin[Classeur]Onglet!'Cellule )
Réf = Réf_Ext & Tb_Adresses_Source(j, 1)
'Formule gérant les cellules vides (pour ne pas avoir de zéro si la cellule lue est vide)
Formule = "=IF(ISBLANK(" & Réf & "),""""," & Réf & ")"
With Sh_Cible.Range(Tb_Colonnes_Cible(j, 1) & lgn)
'Ecriture de la formule
.Formula = Formule
'Remplacement par la valeur trouvée
.Value = .Value
End With
Next
End If
End If
End If
Next
Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub RàZ_Import()
With Sh_Effectif
.Protect userinterfaceonly:=True, Contents:=True, Password:=MdP
.[Zone_Import].ClearContents
End With
End Sub
Le bug venait d'une faute d'orthographe (Thisworbook.Save au lieu de Thisworkbook.save) c'est corrigé :
Le code de ThisWorkbook
Enrichi (BBcode):
Private Sub Workbook_Open()
Application.EnableEvents = False
Application.ScreenUpdating = False
'Lance les mises à jour
RàZ_Import
MàJ_Effectifs
'Enregistrement du fichier Thisworkbook.Save
MsgBox "Mise à jour terminée."
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Pour le fichier distant je remets à blanc la plage de saisie quand on change la date après un double clic :
(J'ai créé un nom "PlageEffectifs" correspondant à toute la plage de saisie des effectifs :
Ton code modifié :
Enrichi (BBcode):
Option Explicit
'Constantes de la liste de validation
Private Const AdresseCelluleCalendrier = "B9:B10"
'----------------------------------------------------------------------
'Sur sélection de la cellule sujette à liste de validation par ComboBox
'----------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DateChoisie As Date
'Pas concerné par la saisie
If Target.Areas.Count > 1 Then Exit Sub
'Calendrier
If Not Intersect(Target, Me.Range(AdresseCelluleCalendrier)) Is Nothing Then
DateChoisie = Calendrier(AfficheJoursFériés:=True)
If DateChoisie <> 0 Then
Me.Range(AdresseCelluleCalendrier).Value = DateChoisie
'La date a changé remise à blanc de la plage de saisie (plage nommée "PlageEffectifs") Me.[PlageEffectifs].ClearContents
Cancel = True
End If
End If
End Sub
Voilà, j'espère que cela ira (à partir de demain et pour 8 jours je serai sans PC)
Amicalement Alain
PS : si c'est le cas, pense à noter ce post en tant que solution.
Apres réflexion je me demande si ce n'est pas plus judicieux d'abandonner le calendrier avec double click dans ( 01 petite sirène ) et avoir dans la cellule date la fonction aujourd'hui tout en gardant la remise a zéro du formulaire des que la date change ?
Apres réflexion je me demande si ce n'est pas plus judicieux d'abandonner le calendrier avec double click dans ( 01 petite sirène ) et avoir dans la cellule date la fonction aujourd'hui tout en gardant la remise a zéro du formulaire des que la date change ?
Bon dans ce cas ... J'ai modifié le code et mis dans la plage DateDuJour la fonction AUJOURDHUI().
Voici la liste des noms définis pour les classeurs distants (Exemple ici 01 PETITE SIRENE)
J'ai supprimé le code devenu inutile et modifié le code de ThisWorkbook comme suit :
Enrichi (BBcode):
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)'Date de dernière modif enregistrée dans le Nom (déjà créé) "DerModif"
Me.Names("DerModif").RefersTo = Date
End Sub
Private Sub Workbook_Open()
Dim WSh As Worksheet
Set WSh = Feuil1 'Feuil1 : Nom VBA de la feuille contenant les effectifs 'Si la date a changé : remise à blanc de la plage de saisie (plage nommée "PlageEffectifs")
If [DerModif] <> Date Then WSh.[PlageEffectifs].ClearContents
End Sub
A chaque enregistrement du fichier, donc lors du dernier enregistrement bien sûr, le nom "DerModif" est mis à jour avec la date du jour.
Lors de l'ouverture du fichier, on vérifie si la date du jour correspond à la date de la dernière modif, si ce n'est pas le cas on efface les valeurs de la zone de saisie des effectifs.
(Je pense qu'on ne peut pas directement comparer la date du jour à la date renvoyée par AUJOURDHUI() car elles sont toujours identiques, d'où le passage par un nom redéfini lors du dernier enregistrement du fichier)
A tout hasard, j'ai ajouté au classeur EFFECTIF DU JOUR une macro pour créer tous les fichiers distants, et je les ai créés.
Voir les pièces jointes
Amicalement
Alain
Mise à jour du 02/10/2022 en réponse aupost#7
Modification du nom défini "Zone_Import" dans le classeur "00 EFFECTIF DU JOUR.XLSM"
Bon dans ce cas ... J'ai modifié le code et mis dans la plage DateDuJour la fonction AUJOURDHUI().
Voici la liste des noms définis pour les classeurs distants (Exemple ici 01 PETITE SIRENE)
J'ai supprimé le code devenu inutile et modifié le code de ThisWorkbook comme suit :
Enrichi (BBcode):
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)'Date de dernière modif enregistrée dans le Nom (déjà créé) "DerModif"
Me.Names("DerModif").RefersTo = Date
End Sub
Private Sub Workbook_Open()
Dim WSh As Worksheet
Set WSh = Feuil1 'Feuil1 : Nom VBA de la feuille contenant les effectifs 'Si la date a changé : remise à blanc de la plage de saisie (plage nommée "PlageEffectifs")
If [DerModif] <> Date Then WSh.[PlageEffectifs].ClearContents
End Sub
A chaque enregistrement du fichier, donc lors du dernier enregistrement bien sûr, le nom "DerModif" est mis à jour avec la date du jour.
Lors de l'ouverture du fichier, on vérifie si la date du jour correspond à la date de la dernière modif, si ce n'est pas le cas on efface les valeurs de la zone de saisie des effectifs.
(Je pense qu'on ne peut pas directement comparer la date du jour à la date renvoyée par AUJOURDHUI() car elles sont toujours identiques, d'où le passage par un nom redéfini lors du dernier enregistrement du fichier)
A tout hasard, j'ai ajouté au classeur EFFECTIF DU JOUR une macro pour créer tous les fichiers distants, et je les ai créés.
C1, la cellule qui contient "RESTAURATIONS" (tout comme C24) ?
Sûr ? Tu la renseigneras manuellement ensuite ?
Je verrai cela demain quand je disposerai de mon PC, là sur mon téléphone ce n'est pas possible.
Amicalement
Alain
Oups ! je viens de voir que tu avais modifié le fichier ... Ok à demain.
Je mets à jour le post#6 (clic) , pièce jointe "00 EFFECTIF DU JOUR modifié.xlsm" Marque le comme solution si tu n'as plus de demande complémentaire cette fois !
Bonsoir @Quicksland
As tu pris le fichier "00 EFFECTIF DU JOUR modifié.xlsm" du post#6 ?
Car avec moi ça fonctionne :
C1 est bien effacée lors de la remise à zéro !
Avec le nom défini "Zone_Import" correctement défini :
Post moi ton fichier avant remise à zéro que je regarde.
Amicalement
Alain
Bonsoir @Quicksland
As tu pris le fichier "00 EFFECTIF DU JOUR modifié.xlsm" du post#6 ?
Car avec moi ça fonctionne : Regarde la pièce jointe 1151251
C1 est bien effacée lors de la remise à zéro !
Avec le nom défini "Zone_Import" correctement défini : Regarde la pièce jointe 1151252
Post moi ton fichier avant remise à zéro que je regarde.
Amicalement
Alain
Apres plusieurs mois d'utilisation sans accros , je me retrouve avec un petit soucis
dans le fichiers effectif je rencontre un problème ...
J'ai ajouté trois ligne supplémentaire pour trois nouveau centres mais bien que la mise a jour fonctionne très bien ,
l' effacement via le bouton ne fonctionne pas pour les trois nouvelle lignes
De plus les trois nouveau fichiers ont un problème a l'ouverture ( ci joint la photo du beug )
Je te joint les fichiers ...
le fichier effectif du jour
le fichier astuce qui fonctionne parfaitement
et un des trois nouveau fichier qui pose problème a l'ouverture puis la photo du beug
Serait-il possible que tu regardes des que tu peux
Tu as copié des classeur qui comprenaient 2 feuilles en en supprimant une, mais sans modifier la macro Workbook_Open de ces classeurs qui fait référence à 2 feuilles ...
Je te propose de modifier tous tes classeurs de ce type :
PETITE SIRENE.xlsm
ASTUCE.xlsm
LES CIGALES.xlsm
LA BUISSONNIERE.xlsm
LA SALAMANDRE.xlsm
LA RIBAMBELLE.xlsm
LES MARMOUZETS.xlsm
LES MENESTRELS.xlsm
DEMAT.xlsm
1 EMILE FOEX.xlsm
NAUTILUS BERLIOZ LAUNAY.xlsm
LE PETIT PRINCE.xlsm
ASTUCE.xlsm
ALBERT ET MARINE LAUNAY.xlsm
LES LUCIOLES.xlsm
LES SANSONNETS.xlsm
ST LUCIEN LA GRENOUILLERE.xlsm
ORANGE BLEUE.xlsm
2 PHILEAS LEBESGUE.xlsm
ST LUCIEN LA GRENOUILLERE.xlsm
BOSQUET.xlsm
CAMUS.xlsm
MICHEL GORIN.xlsm
De la façon suivante :
Supprimer les noms PlageEffectifs1, PlageEffectifs2 etc (s'il y en a plus de 2)
Créer un nom PlageEffectifs de la façon suivante :
PlageEffectifs
=!$C$14:$H$14;!$C$22:$H$22;!$C$29:$H$29
Note bien le point d'exclamation devant les références de plage, cela signifie que ces plages sont relatives à la feuille active.
3. Remplace le code Workbook_Open() de ces classeurs par le suivant :
VB:
Private Sub Workbook_Open()
Dim WSh As Worksheet
'Si la date a changé : remise à blanc de la plage de saisie (plages nommées "PlageEffectifs1" et "PlageEffectifs2")
If [DerModif] <> Date Then
For Each WSh In ThisWorkbook.Worksheets
WSh.[PlageEffectifs].ClearContents
Next WSh
End If
End Sub
De cette façon, tu pourras créer de nouveaux classeurs à partir de classeurs préexistants sans te soucier du nombre de feuilles qu'ils contiennent.
L'idéal serait de paramétrer le nom défini "Zone_Import" pour que tu n'aies pas à le redéfinir lorsque tu ajouteras de nouveau d'autres classeurs. Mais ça ce sera pour une autre fois ...
Je te remercie de t'être penché sur mon problème
J'ai bien pris note de tes précisions
Effectivement j'ai fait un copier coller d'un fichier a double feuille , je ne pensai pas que cela aurai cette incidence
Les trois nouveaux fichier seront temporaire mais malgré tout je les laisserais puis les renommerais en fonction des besoins sans oublié le changement dans la table