Bonjour,
je rencontre un pb de mise à jour des données du formulaire à l'ouverture du fichier.
Pour l'ouverture, module avec le code suivant:
Sub auto_open()
frmAlertes.Show
Application.ScreenUpdating = False
End Sub
Dans une feuille (SIE) sont effectués différents tris qui alimentent ensuite deux autres feuilles PROV et DEF. Après, ces deux feuilles sont récupéréees dans deux listbox (LstProv et LstDef) de l'USF (frmAlertes).
Le code (dans frmAlertes) est le suivant:
'Début
Private Sub UserForm_Initialize()
'Tris pour les alertes
Application.ScreenUpdating = False 'Pas d'affichage de la feuille lors du lancement
Me.Repaint 'Initilisation de l'affichage
'On affiche la feuille PROV pour la vider des données précédentes
LstProv.Clear 'Init liste Prov
Worksheets("Prov").Visible = True
Worksheets("Prov").Select
Columns("A:K").Select
Selection.Delete Shift:=xlToLeft
Worksheets("Prov").Range("A1").Select
'Et aussi Def
LstDef.Clear 'Init liste Def
Worksheets("Def").Visible = True
Worksheets("Def").Select
Columns("A:N").Select
Selection.Delete Shift:=xlToLeft
Worksheets("Def").Range("A1").Select
'Et on filtre la feuille SIE pour Prov
Worksheets("sie").Activate
Worksheets("sie").Range("J1").Select
Selection.AutoFilter
Worksheets("sie").Range("A1").Select
Selection.AutoFilter Field:=10, Criteria1:="DECLARER PROV" 'Field =n° de colonne pour le filtre
Worksheets("sie").Range("J:Y,AB:AE").Select
Selection.EntireColumn.Hidden = True
Worksheets("sie").Range("A1").Select
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Copy
'Puis on colle la sélection dans la feuille PROV
Worksheets("Prov").Select
Worksheets("Prov").Range("A1").Select
ActiveSheet.Paste
Columns("A:K").Select
Selection.Columns.AutoFit
Worksheets("Prov").Range("A1").Select
Selection.Columns.AutoFit 'Ajustement automatique de la taille des colonnes
'Sauf les suivantes qui sont précisées pour prov
Columns("A:A").ColumnWidth = 30
Columns("B:B").ColumnWidth = 3
Columns("D:D").ColumnWidth = 11
Columns("E:E").ColumnWidth = 6
Columns("F:H").ColumnWidth = 10
Columns("I:I").ColumnWidth = 4
Columns("J:K").ColumnWidth = 6
Worksheets("Prov").Range("A2").Select
'Et on trie nombre de jours limite par ordre croissant
Worksheets("Prov").Range("I2").Select
Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Worksheets("Prov").Range("I2").Select
' On paramètre le format de la DATE PROV en JJ/MM/AAAA
Columns("H:H").Select
Selection.NumberFormat = "dd/mm/yyyy"
Worksheets("Prov").Range("A2").Select
'Et on supprime le filtre pour Prov
Worksheets("sie").Activate
Cells.Select
Selection.EntireColumn.Hidden = False
Selection.AutoFilter
Worksheets("sie").Range("A1").Select
'On fait la même opération pour Def
Worksheets("sie").Activate
Worksheets("sie").Range("P1").Select
Selection.AutoFilter
Worksheets("sie").Range("A1").Select
Selection.AutoFilter Field:=16, Criteria1:="DECLARER DEF" 'Field= n° de colonne pour le filtre
Worksheets("sie").Range("H:J,P:Y,AB:AE").Select
Selection.EntireColumn.Hidden = True
Worksheets("sie").Range("A1").Select
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Copy
'Puis on colle la sélection dans la feuille DEF
Worksheets("Def").Select
Worksheets("Def").Range("A1").Select
ActiveSheet.Paste
Columns("A:N").Select
Selection.Columns.AutoFit
Worksheets("Def").Range("A1").Select
'On ajuste les colonnes du tableau Def
Columns("A:A").ColumnWidth = 30
Columns("B:B").ColumnWidth = 3
Columns("D:D").ColumnWidth = 11
Columns("E:E").ColumnWidth = 6
Columns("F:K").ColumnWidth = 10
Columns("L:L").ColumnWidth = 4
Columns("M:N").ColumnWidth = 6
Worksheets("Def").Range("A2").Select
'Puis on trie nombre de jours par ordre croissant
Worksheets("Def").Range("L2").Select
Selection.Sort Key1:=Range("L2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Worksheets("Def").Range("L2").Select
' On paramètre le format de la DATE DEF en JJ/MM/AAAA
Columns("K:K").Select
Selection.NumberFormat = "dd/mm/yyyy"
Worksheets("Def").Range("A2").Select
'On supprime les filtres de la feuille SIE
Worksheets("sie").Activate
Cells.Select
Selection.EntireColumn.Hidden = False
Selection.AutoFilter
Worksheets("sie").Range("A1").Select
'Et on fait une recopie des formules alerte Prov et Def
'Colonne Prov
Worksheets("sie").Range("H2:J2").Select
Selection.AutoFill Destination:=Range("H2:J1000")
'Sheets("sie").Range("H2:J1000").Select
Worksheets("sie").Range("A2").Select
'Colonne Def
Worksheets("sie").Range("N2:P2").Select
Selection.AutoFill Destination:=Range("N2:P1000")
'Sheets("sie").Range("N2:P1000").Select
Worksheets("sie").Range("A2").Select
'Comptage des éléments - lignes 2 à 1000
With Application.WorksheetFunction
Worksheets("sie").Range("AC1") = Application.WorksheetFunction.CountIf(Range("J2:J1000"), "=DECLARER PROV")
Worksheets("sie").Range("AD1") = Application.WorksheetFunction.CountIf(Range("P2:P1000"), "=DECLARER DEF")
End With
'Alertes provisionnelles
'On récupère les infos sur la feuille Prov
LstProv.RowSource = ("Prov!A2:K50") '!!!! Depuis le titre jusqu'à ligne 50
With Worksheets("Prov")
'
For Each c In Worksheets("Prov").Range("i2")
If c.Value < 15 Then 'rouge
LblProv.BackColor = &HFF&
LblProv.ForeColor = &HFFFFFF
NbProv.BackColor = &HFF&
NbProv.ForeColor = &HFFFFFF
End If
If c.Value >= 15 And c.Value <= 30 Then 'orange
LblProv.BackColor = &H80FF&
LblProv.ForeColor = &HFFFFFF
NbProv.BackColor = &H80FF&
NbProv.ForeColor = &HFFFFFF
End If
If c.Value > 30 Or c.Value = "" Then 'vert
LblProv.BackColor = &H8000&
LblProv.ForeColor = &HFFFFFF
NbProv.BackColor = &H8000&
NbProv.ForeColor = &HFFFFFF
End If
Next c
End With
'Alertes définitives
'On récupère les infos sur la feuille Def
LstDef.RowSource = ("Def!A2:N50") '!!!! Depuis le titre jusqu'à ligne 50
With Worksheets("Def")
'
'For Int_Indice = 0 To Int_MaxLigneDef
For Each c In Worksheets("Def").Range("L2")
If c.Value < 60 Then
LblDef.BackColor = &HFF&
LblDef.ForeColor = &HFFFFFF
NbDef.BackColor = &HFF&
NbDef.ForeColor = &HFFFFFF
End If
If c.Value >= 60 And c.Value <= 150 Then
LblDef.BackColor = &H80FF&
LblDef.ForeColor = &HFFFFFF
NbDef.BackColor = &H80FF&
NbDef.ForeColor = &HFFFFFF
End If
If c.Value > 150 Or c.Value = "" Then
LblDef.BackColor = &H8000&
LblDef.ForeColor = &HFFFFFF
NbDef.BackColor = &H8000&
NbDef.ForeColor = &HFFFFFF
End If
Next c
End With
Application.ScreenUpdating = True
End Sub
'Fin
L'autre procédure, qui fonctionne parfaitement, est la suivante:
A partir du menu principal, on peut générer les mêmes alertes en cliquant sur un bouton ALERTES :
Private Sub GenerAlertes_Click()
'Unload Me
frmAlertes.Show 'On affiche à nouveau les alertes
End Sub
On accède ainsi au frmAlertes (code ci-dessus).
Merci pour toute aide.
Afficher la suite
