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