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 !