Désactivation macro(demande de log) fichier fille

Bonjour à tous

J'essai de mettre à jour un systeme de fichier pour mes commandes mais qui rencontre quelques faiblesses et si possible avant 2021 :)

J'utilise un fichier maitre qui genere / met à jour ... x fichiers filles.

Le fichier fille lance un userform avec demande de log pour les utilisateurs.

Jusqu'a maintenant je contournais le probleme en vérifiant si le fichier Maitre était ouvert, si c'etait le cas l'userform ne se lancait pas . c'était parfait ou presque... car le fichier maitre reste ouvert pratiquement en permanance, donc le log qui permettait de faire de la tracabilité au niveau des fichiers filles ne neservait plus à rien

J'ai essayé avec des déclaration de variable publique mais evidemment ca ne fonctionne pas vu que ce sont des projets vba différent, il semblerai que l'on puis l'utiliser mais avec des réferences mais mes tentatives ne donne rien.

Autre information de taille j'ai besoin du blocage que pour mes maros dispacher et compil du fichier maitre ( COMTOSAP)

Avez vous des idées pour resoudre ce probleme : Les fichiers etant lourd je propose les macros mais si vous avez besoin des fichiers je suis pret à les fournirs en mp

Code dans un module fichier Maitre

Sub dispatcher()
Dim Tbl As Variant, data As Variant, i%
Dim dico1 As Object, cle1 As Variant, result1 As Variant
Dim wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog, racine As String
Dim colonne$, critere%
Dim M As String, MonFichier As String

    colonne = "A" 'Application.InputBox("Entrez la colonne servant de critère de dispatching : ", "Saisie en texte (i.e : A B ...)", Type:=2)
    critere = ActiveSheet.Columns(colonne).Column

    racine = Split(ThisWorkbook.Name, ".")(0)
    M = Sheets("Param").Cells(1, 2)
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage du fichier généré"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    data = Sheets(1).Cells(Rows.Count, 1).End(xlUp).CurrentRegion
Application.ScreenUpdating = False
    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = LBound(data) + 1 To UBound(data) ' hors en-tête
        dico1(data(i, critere)) = ""
    Next

    For Each cle1 In dico1.Keys
        result1 = filtreArray(data, critere, cle1)
        MonFichier = (MonRepertoire & "\Commande " & cle1 & ".xlsm")

        If FichierExiste(MonFichier) = True Then ' fonction qui vérifié l'existance du fichier
            'MsgBox "Le fichier existe..."
            Set wb = Workbooks.Open(MonFichier)
            Else
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Utilisateur.xlsm")
        End If
        wb.Sheets(M + 1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
            wb.Sheets(M + 1).Name = MonthName(M)
            wb.Sheets(M + 1).Protect
            wb.Sheets(14).Cells(1, 8) = M
            Application.DisplayAlerts = False
            wb.SaveAs (MonRepertoire & "\Commande " & cle1 & ".xlsm")
            wb.Close
            Application.DisplayAlerts = True
            Set wb = Nothing
    Next
 Application.ScreenUpdating = True
    MsgBox "Terminé, fichiers sauvegardés sous """ & MonRepertoire & "\" & """ !"
End Sub

Pour les fichiers filles voici le code ds thisworkbook

Private Sub Workbook_Open() 'déclanchement de la macro à l'ouverture du fichier
Dim MonClasseur As String

Application.ScreenUpdating = False
Call SetTimer
Sheets(1).Visible = True
With Sheets(1).Shapes("Logo") 'noms à adapter
  .Width = ActiveWindow.Width 'Ajustement de la taille de "Image 1"
End With
Sheets(1).Protect
For i = 2 To 13
    If Cells(2, 1) <> "" Then
    Sheets(i).Protect
    End If
Sheets(i).Visible = False
Next i

MonClasseur = Feuil14.Cells(1, 4)
If COMTOP = True Then
 For i = 1 To 14
    Sheets(i).Unprotect
    Sheets(i).Visible = True
    Next i

'Verification = EstClasseurOuvert(MonClasseur)
'If Verification = False Then
'    If Feuil14.Visible = True Then Feuil14.Visible = False
Else
ULog.Show
End If

Application.ScreenUpdating = True

End Sub

Je tourne en rond

HELP

bon je contourne le probleme, en ecrivant si la macro est en train de s'executer et je verifie cette valeur de de la maniere suivante dans mon fichier maitre :

en debut de macro :

Dim colonne$, critere%

Dim M As String, MonFichier As String

Sheets(14).Cells(2, 2).Value = 1

et en Fin

   Sheets(14).Cells(2, 2).Value = 0
 Application.ScreenUpdating = True
    MsgBox "Terminé, fichiers sauvegardés sous """ & MonRepertoire & "\" & """ !"

Puis dans thisworkbook des fichiers filles

Private Sub Workbook_Open() 'déclanchement de la macro à l'ouverture du fichier
Dim MonClasseur As String

Application.ScreenUpdating = False
Call SetTimer
Sheets(1).Visible = True
With Sheets(1).Shapes("Logo") 'noms à adapter
  .Width = ActiveWindow.Width 'Ajustement de la taille de "Image 1"
End With
Sheets(1).Protect
For i = 2 To 13
    If Cells(2, 1) <> "" Then
    Sheets(i).Protect
    End If
Sheets(i).Visible = False
Next i

MonClasseur = Feuil14.Cells(1, 4)
Verification = EstClasseurOuvert(MonClasseur)
If Verification = False Then
    If Feuil14.Visible = True Then Feuil14.Visible = False
ULog.Show

Else

Dim CL As Workbook
Dim O As Worksheet
Set CL = Workbooks("ComToSAP_V61.xlsm")
Set O = CL.Sheets("Param")

If O.Cells(2, 2).Value = 0 Then
ULog.Show
Else
    For i = 1 To 14
    Sheets(i).Unprotect
    Sheets(i).Visible = True
    Next i
End If
End If
Application.ScreenUpdating = True

End Sub

Pas très satisfaisant mais rapide à l'execution, mais si vous avez d'autre idée je suis prenneur !

Rechercher des sujets similaires à "desactivation macro demande log fichier fille"