XL 2019 modification macro 2

Quicksland · 22 Septembre 2022

Bonsoir le forum,

En essayant les diffèrent cas de figure que je pourrai rencontrer par la suite ...

Un petit soucis me bloque

Si un fichier distant n'a pas été mise a jour ( changement des comptes dans les cellules)

la mise a jour du lendemain se fait avec les chiffres de la veille ...

Serait-il possible que dans le fichier "EFFECTIF DU JOUR" en appuyant sur le bouton "REMISE A ZERO" cela efface les cellules du fichier comme cela

fonctionne actuellement puis efface également les cellules des fichiers distant exemple: "01 PETITE SIRENE" C14,D14,E14,F14,G14,H14 et

C22,D22,E22,F22,G22,H22 ( fichiers distant par la suite protégée par mot de passe)

Merci

AtTheOne · 23 Septembre 2022

Bonjour à toutes & à tous, bonjour @Quicksland

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.

Amicalement
Alain

Quicksland · 24 Septembre 2022

Bonjour @AtTheOne

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

En tout cas c'est déjà du très bon boulot

Je te remercie d'avance pour tout

AtTheOne · 24 Septembre 2022

Bonjour à toutes et à tous, bonjour @Quicksland

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.

Quicksland · 24 Septembre 2022

Bonjour @AtTheOne

Tout fonctionne parfaitement

C'est vraiment du bon boulot !

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 ?

En tout les cas je te remercie pour ton aide

AtTheOne · 24 Septembre 2022

Bonsoir à toutes et à tous, bonsoir @Quicksland

Quicksland à dit:
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)

Nom	Définition
DateDuJour	='PETITE SIRENE'!$B$9
DerModif	44828
PlageEffectifs	='PETITE SIRENE'!$C$14:$H$14;'PETITE SIRENE'!$C$22:$H$22;'PETITE SIRENE'!$C$29:$H$29

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 au post#7
Modification du nom défini "Zone_Import" dans le classeur "00 EFFECTIF DU JOUR.XLSM"

Noms définis
Date_MàJ	=Tables!$L$3
Onglet_Cible	=Tables!$B$3
Zone_Import	=EFFECTIF!$C$1;EFFECTIF!$B$4:$B$23;EFFECTIF!$E$4:$J$23;EFFECTIF!$Q$4:$V$23

Plus PJ "00 EFFECTIF DU JOUR modifié.xlsm"
(Autres PJ inchangées)
Amicalement
Alain

Quicksland · 1 Octobre 2022

AtTheOne à dit:
Bonsoir à toutes et à tous, bonsoir @Quicksland

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)

Nom Définition
DateDuJour ='PETITE SIRENE'!$B$9
DerModif 44828
PlageEffectifs ='PETITE SIRENE'!$C$14:$H$14;'PETITE SIRENE'!$C$22:$H$22;'PETITE SIRENE'!$C$29:$H$29

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

Bonjour @AtTheOne

Tout fonctionne parfaitement bien

Une dernière demande ...

Dans le classeur "00 EFFECTIF DU JOUR" en C1 j'aimerai que cette cellule s'efface lors de la remise a zéro du tableau

Je te remercie pour tout

AtTheOne · 1 Octobre 2022

Bonjour à toutes & à tous, bonjour @Quicksland

Quicksland à dit:
Dans le classeur "00 EFFECTIF DU JOUR" en C1 j'aimerai que cette cellule s'efface lors de la remise a zéro du tableau

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.

AtTheOne · 2 Octobre 2022

Bonsoir à toutes & à tous, bonsoir @Quicksland
en réponse à ta dernière demande :

Quicksland à dit:
Dans le classeur "00 EFFECTIF DU JOUR" en C1 j'aimerai que cette cellule s'efface lors de la remise a zéro du tableau

Il suffisait de modifier le nom défini "Zone_Import" en y incluant la cellule C1 sans toucher aux macros :

Noms définis
Date_MàJ	=Tables!$L$3
Onglet_Cible	=Tables!$B$3
Zone_Import	=EFFECTIF!$C$1;EFFECTIF!$B$4:$B$23;EFFECTIF!$E$4:$J$23;EFFECTIF!$Q$4:$V$23

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 !

Amicalement Alain

Quicksland · 3 Octobre 2022

Bonjour @AtTheOne

désolé mais cela ne fonctionne pas

j'ai ajouté...

=EFFECTIF!$C$1;EFFECTIF!$B$4:$B$23;EFFECTIF!$E$4:$J$23;EFFECTIF!$Q$4:$V$23

mais le résultat en C1 ne s'efface pas !

Merci pour ton aide

AtTheOne · 3 Octobre 2022

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

Quicksland · 3 Octobre 2022

AtTheOne à dit:
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

Re,

Désolé je me suis tromper de fichier

Tout fonctionne parfaitement bien

Merci pour ton aide et pour ta patience

Bonne soirée

Effectuez une recherche sur Excel Downloads...

XL 2019 modification macro 2

Quicksland

XLDnaute Occasionnel

Pièces jointes

AtTheOne

AtTheOne

XLDnaute Impliqué

Pièces jointes

Quicksland

XLDnaute Occasionnel

Pièces jointes

AtTheOne

XLDnaute Impliqué

Pièces jointes

Quicksland

XLDnaute Occasionnel

AtTheOne

XLDnaute Impliqué

Pièces jointes

Quicksland

XLDnaute Occasionnel

Pièces jointes

AtTheOne

XLDnaute Impliqué

AtTheOne

XLDnaute Impliqué

Quicksland

XLDnaute Occasionnel

AtTheOne

XLDnaute Impliqué

Quicksland

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums