comment faire pour qu'une form reste toujours active ?

[tomtom0906]

salut

je fais suite a mon post sur la progressBar...
j'ai reussi a faire une pseudo bar avec une valeur qui s'accroit au fur et a mesure que j'avance dans mon code.
dans un userform, j'ai un trait dont j'allonge la longueur avec la valeur placé au fil de mon code.
par contre, ma form qui contient ma Barre s'affiche en blanc certaines fois ?
comment faire pour que je la vois toujours a l'ecran ?

 

[PascalXLD]

Re : comment faire pour qu'une form reste toujours active ?

Bonjour

il faut qu'après ta modif de ta barre tu fasses un

maform.repaint

Bon courage

 

[tomtom0906]

Re : comment faire pour qu'une form reste toujours active ?

c'est que j'ai fait, mais a l'interieur d'un sub que j'appelle

en algo ca donne

longueur bar = 10
call update bar

ouverture fichier 1
ouverture ok
longueur bar = 20
call update bar

ouverture fichier 2
ouverture ok
longueur bar = 40
call update bar

...

Sub update bar
j'augmente le width de ma barre
Repaint
End Sub

voila ce que je fais mais apres ou avant l'ouverture de mes fichiers ma form contenant ma barre s'affiche en blanc !

 

[PascalXLD]

Re : comment faire pour qu'une form reste toujours active ?

Re

dans ton

Sub update bar
j'augmente le width de ma barre
Repaint
End Sub

il faut mettre le nom de ton UF devant repaint

 

[tomtom0906]

Re : comment faire pour qu'une form reste toujours active ?

je l'ai bien mis :


Sub UpdateProgress(PourcentageEffectue)
With FrmProgression
.FrameProgress.Caption = Format(PourcentageEffectue, "0%")
.LabelProgress.Width = PourcentageEffectue * (.FrameProgress.Width - 10)
.Repaint
End With
End Sub

en fait ma form n'est pas toujours active, et elle devient blanche lorque j'ouvre un tres gros fichier ! j'appelle ma fonction UpdateProgress plusieurs fois de suite

ma progressBar n'est pas terrible non plus car je ne sais pas comment la mettre en oeuvre sachant que ce qui prend du temps est l'ouverture de mes fichiers

 

[PascalXLD]

Re : comment faire pour qu'une form reste toujours active ?

Re

Mais là tu repaint ta frame et non ton UF

Il faut faire le repaint sur l'UF qui contient ta frame

 

[tomtom0906]

Re : comment faire pour qu'une form reste toujours active ?

mon userform s'appelle FrmProgression donc je fais bien le repaint la dessus ou alors quelque chose m'echappe encore

 

[PascalXLD]

Re : comment faire pour qu'une form reste toujours active ?

Oups zut en effet j'avais lu trop vite

Pourtant je l'ai fait un paquet de fois avec le repaint eça marche impec

Faudrait peut-être voir le fichier

 

[tomtom0906]

Re : comment faire pour qu'une form reste toujours active ?

si ma UF etait toujours active je pense que ca serait bon mais la elle n'est plus active...
j'peux pas mettre le fichier c'est tros gros mais voici le code si ca peut t'aider a m'aider :

Sub TraitementExtractComtable()

Dim CheminModele, CheminExtract, CheminDestination As String
Dim wk1 As Workbook, wk2 As Workbook
Dim NewMois, NumMois, NumSemaine, NewSemaine, NewNomFichier As String

CheminModele = "K:\DEL\Services\DO\Programmes\1_Commun\08-Procédures opérationnelles\Procédures internes\Modeles Extract_OPX_WE\Extract comptable OPX_xx_2007_Vx.xls"
CheminExtract = "Y:\Export_opx\Prive\"
CheminDestination = "Y:\Export_opx\Public\Hebdos du Week End\"

'recupere le numero du mois et dela semaine courante
NumMois = Sheets("Actions").Range("E10").Text
NumSemaine = Sheets("Actions").Range("E11").Text
Sheets("Actions").Range("E9").Value = Date

FrmProgression.Show 0

Avancement = 0
LMax = 100
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)

'incremente le mois et la semaine
If NumSemaine = 4 Then
If NumMois = 12 Then
NumMois = 1
Sheets("Actions").Range("E10").Value = NumMois
NewMois = "0" & NumMois
Else
If NumMois < 9 Then
NewMois = "0" & NumMois + 1
Else
NewMois = NumMois + 1
End If
Sheets("Actions").Range("E10").Value = NumMois + 1
End If
NumSemaine = 1
Sheets("Actions").Range("E11").Value = NumSemaine
NewSemaine = "V" & NumSemaine
Else
If NumMois > 9 Then
NewMois = NumMois
Else
NewMois = "0" & NumMois
End If
Sheets("Actions").Range("E10").Value = NumMois
NewSemaine = "V" & NumSemaine + 1
Sheets("Actions").Range("E11").Value = NumSemaine + 1
End If

Avancement = 5
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)

'nouveau nom de fichier
Sheets("Actions").Range("E12").Value = "Extract comptable OPX_" & NewMois & "_2007_" & NewSemaine & ".xls"
NewNomFichier = CheminDestination & "Extract comptable OPX_" & NewMois & "_2007_" & NewSemaine & ".xls"

'ouvrir le fichier excel modele Extract_comptable
Workbooks.Open CheminModele & "", 0, False, , "chouchou", "chouchou"
Set wk1 = Workbooks.Open(CheminModele & "", 0, False, , "chouchou", "chouchou")

'Ouvre la liste des projets et copie dans le modele
Set wk2 = Workbooks.Open(Filename:=CheminExtract & "OPX2-Extract_liste_projet.xls")
Workbooks("OPX2-Extract_liste_projet.xls").Worksheets("OPX2-Extract_liste_projet").Activate
Range("A2:X" & Range("B65536").End(xlUp).Row).Copy
wk1.Sheets("CAT_PRJ").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Extract comptable OPX_xx_2007_Vx.xls").Worksheets("CAT_PRJ").Activate
Sheets("CAT_PRJ").Range("A2").Select
Cells(1, 1).Copy: Application.CutCopyMode = False

Avancement = 15
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)

wk2.Close False

'Ouvre les consommés DSI et copie dans le modele
Set wk2 = Workbooks.Open(Filename:=CheminExtract & "OPX2-Extract_ressources_mois_comptable_CONSOMME_IBP_DSI_.xls")
Workbooks("OPX2-Extract_ressources_mois_comptable_CONSOMME_IBP_DSI_.xls").Worksheets("OPX2-Extract_ressources_mois_co").Activate
Range("A2:X" & Range("B65536").End(xlUp).Row).Copy
Workbooks("OPX2-Extract_ressources_mois_comptable_CONSOMME_IBP_DSI_.xls").Worksheets("OPX2-Extract_ressources_mois_co").Activate
wk1.Sheets("CONSO").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Extract comptable OPX_xx_2007_Vx.xls").Worksheets("CONSO").Activate
Sheets("CONSO").Range("A2").Select
Cells(1, 1).Copy: Application.CutCopyMode = False

Avancement = 30
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)

wk2.Close False

'Ouvre les consommés HORS DSI et copie dans le modele
Set wk2 = Workbooks.Open(Filename:=CheminExtract & "OPX2-Extract_ressources_mois_comptable_CONSOMME_IBP_HORS_DSI_.xls")
FrmProgression.Repaint
Workbooks("OPX2-Extract_ressources_mois_comptable_CONSOMME_IBP_HORS_DSI_.xls").Worksheets("OPX2-Extract_ressources_mois_co").Activate
Range("A2:X" & Range("B65536").End(xlUp).Row).Copy
Workbooks("Extract comptable OPX_xx_2007_Vx.xls").Worksheets("CONSO").Activate
Sheets("CONSO").Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("CONSO").Range("A2").Select
Cells(1, 1).Copy: Application.CutCopyMode = False

Avancement = 50
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)

wk2.Close False

'Ouvre les RAF DSI et copie dans le modele
Set wk2 = Workbooks.Open(Filename:=CheminExtract & "OPX2-Extract_ressources_mois_comptable_RAF_IBP_DSI_.xls")
Workbooks("OPX2-Extract_ressources_mois_comptable_RAF_IBP_DSI_.xls").Worksheets("OPX2-Extract_ressources_mois_co").Activate
Range("A2:X" & Range("B65536").End(xlUp).Row).Copy
Workbooks("OPX2-Extract_ressources_mois_comptable_RAF_IBP_DSI_.xls").Worksheets("OPX2-Extract_ressources_mois_co").Activate
wk1.Sheets("RAF").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Copy: Application.CutCopyMode = False
Workbooks("Extract comptable OPX_xx_2007_Vx.xls").Worksheets("RAF").Activate
Sheets("RAF").Range("A2").Select

Avancement = 75
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)

wk2.Close False

'Ouvre les RAF HORS DSI et copie dans le modele
Set wk2 = Workbooks.Open(Filename:=CheminExtract & "OPX2-Extract_ressources_mois_comptable_RAF_IBP_HORS_DSI_.xls")
Workbooks("OPX2-Extract_ressources_mois_comptable_RAF_IBP_HORS_DSI_.xls").Worksheets("OPX2-Extract_ressources_mois_co").Activate
Range("A2:X" & Range("B65536").End(xlUp).Row).Copy

Workbooks("Extract comptable OPX_xx_2007_Vx.xls").Worksheets("RAF").Activate
Sheets("RAF").Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RAF").Range("A2").Select
Cells(1, 1).Copy: Application.CutCopyMode = False

Avancement = 90
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)
wk2.Close False

ActiveWorkbook.SaveAs Filename:=NewNomFichier
ActiveWorkbook.Close

Avancement = 100
PourcentageEffectue = Avancement / LMax
Call UpdateProgress(PourcentageEffectue)
Workbooks("Automate d'extraction OPX.xls").Worksheets("Actions").Activate
Unload FrmProgression

End Sub

Sub UpdateProgress(PourcentageEffectue)
With FrmProgression
.FrameProgress.Caption = Format(PourcentageEffectue, "0%")
.LabelProgress.Width = PourcentageEffectue * (.FrameProgress.Width - 10)
.Repaint
End With
End Sub