Pb d'ordre d'execution de procédures [Résolu]

Signaler
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008
-
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008
-
Bonjour,
J'ai un bouton Click qui appelle plusieurs procédures : la première vient du même classeur (appelée avec Call) et la seconde vient dans un autre classeur (appelée avec Application.Run) et la troisième du même classeur (Call).

La première procédure consiste à attribuer des valeurs à 2 Combobox d'une même feuille :
Sub Graph_3D_Marc_Init()
Dim mon_objet As OLEObject
Dim mon_objet2 As OLEObject
    Workbooks(nomRiskRegister).Activate
    Worksheets("3D_AllRisks").Activate
    Set mon_objet = Workbooks(nomRiskRegister).Worksheets("3D_AllRisks").OLEObjects("ComboBox1")
    mon_objet.Object.Value = "Point Initial"
    Set mon_objet2 = Workbooks(nomRiskRegister).Worksheets("3D_AllRisks").OLEObjects("Action_Category")
    mon_objet2.Object.Enabled = False
End Sub

La seconde permet de cliquer automatiquement sur un bouton Click :
Private Sub ComboBox1_Change()
Dim ma_combo As OLEObject
Set ma_combo = Me.OLEObjects("ComboBox1")
'MsgBox ("AAA")
If ma_combo.Object.Value = "Point Initial" Then
                Me.OLEObjects("Action_Category").Object.Enabled = False
                Else
                Me.OLEObjects("Action_Category").Object.Enabled = True
End If
End Sub

La troisième copie/colle la plage de données obtenue sous Powerpoint :
Sub Ajout_Slide(nomClasseur As String, plage As Range)
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open(ThisWorkbook.Path & "" & "PPR_AVP_SC2_Silvercrest.ppt")
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer




With PptDoc
 


    '--- Ajoute un nouveau slide
    Set Diapo = .Slides.Add(Index:=position, Layout:=ppLayoutBlank)
    'copie le 1er graphique contenu dans la feuille Excel active
    Windows(nomClasseur).Activate
    plage.Select
    Selection.CopyPicture appearance:=xlScreen, Format:=xlBitmap
    'collage dans la 2eme diapositive
    Diapo.Shapes.Paste
 
    'Renomme et met en forme l'objet collé
    With .Slides(position).Shapes(.Slides(position).Shapes.Count)
   '     .Name = "monGraph" 'personnalise le nom
        .Left = 0 'définit la position horizontale dans le slide
        .Top = 50 'définit la position verticale dans le slide
        .Height = 600 'hauteur
        .Width = 700 'largeur
    End With






End With





position = position + 1





PptDoc.SaveAs Filename:=ThisWorkbook.Path & "" & "PPR_AVP_SC2_Silvercrest.ppt"
PptDoc.Close
PptApp.Quit







End Sub




Et enfin, j'ai un bouton qui appelle ces 3 procédures :


Private Sub CommandButton1_Click()
    Call Graph_3D_Marc_Ini
   





Application.Run "" & nomRiskRegister & "!Feuil14.MAJ_Click"
    Call Ajout_Slide(nomRiskRegister, Worksheets("3D_AllRisks").Range("A2:Z73"))
End Sub



Le truc marche mais il me colle le Range ds Powerpoint avant d'avoir modifié les valeurs dans les Conbobox alors que je lui demande le contraire!!!!
J'aimerais savoir d'où vient le pb car là j'ai épuisé mes ressources...
Qqun aurait-il une idée du pb?
Merci d'avance...

12 réponses

Messages postés
539
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
14 juillet 2010
1
Salut,
A moins que tu sois dans des class différentes ou en code share tu n'as pas besoin de faire un call. Le probleme ici est ton application.run, il faut que tu attendes la fin de l'execution avant de faire ajout slide. Tu es en vba, execute ton code pas à pas et regarde ou cela coince.
@+
youpi :)
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008

Salut youpiyoyo,
Merci d'avoir répondu. Je suis effectivement en VBA et c'est exactement ça mon pb : le fait que l'application.run n'attende pas la fin de l'exécution précédente.
Mais comment puis-je faire pour ajouter un temps d'attente (je sais pas si c'est possible)? La méthode pas à pas je l'ai faite et j'ai remarqué que la fonction qui change les valeurs dans les Combobox est plus longue que l'ajout sur slide (enfin longue au sens 3 secondes au lieu de 1).
Aurais-tu une solution à ce pb car je l'ai aussi rencontré auparavant où je demande à ouvrir un onglet puis d'afficher un pessage (msgbox) et il m'afficher le message systématiquement avant de s'être placé dans l'onglet que je lui demandais...c'est assez pénible...
Merci
Messages postés
539
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
14 juillet 2010
1
ceci est le gros problème de vba... en .net tu fais un threading.sleep(miliseconde) et tu boucles sur l'existence ou l'execution de code et c'est très simple.
Alors c'est un peu tiré par les cheveux mais tu as cette solution:
chercher le process powerpoint pour qu'il finisse son execution pusique tu fais (PptApp.Quit)
    process_handle = OpenProcess(SYNCHRONIZE, 0, taskid)
    If process_handle <> 0 Then
            WaitForSingleObject process_handle, INFINITE
            CloseHandle process_handle
    End If
taskId représente le process id de powerpoint regarde sur google pour la déclaration de openprocess etc... (declare openprocess par exemple)
si c'est ton excel qui est plus long a s'executer:
deuxieme solution:
exemple pour conaitre le state d'un object (table) en access
ChildTableIsOpen = (AppAcc.SysCmd(AcSysCmdAction.acSysCmdGetObjectState, access.AcObjectType.acTable, TableName) And access.Constants.acObjStateOpen) <> False
SysCmd existe dans excel vba je viens d'aller voir regarde si tu trouves sur google le state d'excel en execution ou quoi. tu peux creuser vers cette solution
si tu trouve rien fais le moi savoir je regarderai plus en details, peut etre qu'il faudra que tu m'envoi ton fichier excel pour que je regarde avec ton accord.
@+
youpi :)
Messages postés
539
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
14 juillet 2010
1
oubli SysCmd c'est du access application
il me faudrait des details sur Application.Run "" & nomRiskRegister & "!Feuil14.MAJ_Click"
pour regarder s'il y a pas un evenement qui puisse me permettre de lancer Ajout_Slide
@+
youpi :)
Messages postés
539
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
14 juillet 2010
1
vba n'est pas vraiment compilé il execute ligne par ligne, et c'est ce qui est bien pour commencer et faire des trucs simple, mais quand tu commences a vouloir des trucs élaborés tu es vite limités, même en terme de cpu.
pourquoi tu ne ferais pas un public sub MAJ_Click
(Optional ByVal AddSlide As Boolean)

a la fin tu fais un if AddSlide = true then Ajout_Slide
tu n'as plus besoin de ton Application.Run car tu l'a mis en public, comme l'argument est optional ceci ne bloquera pas ton bouton.
et tu lances ton  ta procédure comme cela : MAJ_Click True
@+
youpi :)
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008

ohlala...je crois que ça dépasse mes connaissances informatiques... mais je ne baisse jamais les bras donc je vais comprendre...
Je vois ce que tu veux dire mais l'appliquer est une autre affaire...
La commande

Application.Run "" & nomRiskRegister & "!Feuil14.MAJ_Click"
appelle le bouton qui se situe sur une feuille donc le code est :




Sub MAJ_Click()

Select Case Me.OLEObjects("Combobox1").Object.Value

    Case ""
    MsgBox ("Choississez Point Initial ou une date")

    Case "Point Initial"
        Call aller_chercher("Point Initial")
        Call Remplissage_tableau
        Me.OLEObjects("Action_Category").Object.Value = ""

    Case Else
    If IsDate(Me.OLEObjects("Combobox1").Object.Value) = False Then
    MsgBox ("Choississez 'Point Initial', une date dans la liste" & Chr(10) & " ou entrez une date au format 'jj/mm/aaaa'")
    Me.OLEObjects("Combobox1").Object.Value = ""
    Else

    Select Case Me.OLEObjects("Action_Category").Object.Value

    Case ""
    MsgBox ("Choississez un type d'action")

    Case "Actual"
        Call aller_chercher(Me.OLEObjects("Combobox1").Object.Value, "Actual")
        Call Remplissage_tableau

    Case "Proposed"
        Call aller_chercher(Me.OLEObjects("Combobox1").Object.Value, "Proposed")
        Call Remplissage_tableau

    Case Else
        MsgBox ("Choississez un type d'action dans la liste")
        Me.OLEObjects("Action_Category").Object.Value = ""
    End Select
       
    End If
End Select
End Sub


J'ai 2 Combobox (Combobox1 et Action_Category).
Je fais appelle aux procédures
aller_chercher et Remplissage_tableau
.
Leurs codes respectifs sont :

Sub aller_chercher(mon_option1 As String, Optional mon_option2 As String)
Dim wbk As Workbook
Dim wks As Worksheet







Set wbk = ThisWorkbook
Set wks = wbk.Worksheets("3D_AllRisks")








Dim mes_valeurs(3) As Integer








Dim mon_AppEx As Excel.Application
Set mon_AppEx = New Excel.Application








Dim wbk_source As Workbook
Set wbk_source = mon_AppEx.Workbooks.Open(wbk.Worksheets("updating").Cells(250, 1).Value, , True)
wbk.Activate








Dim date_col As Integer
Dim debut_ligne As Integer








Dim max_nb As Integer
Dim mon_graph As ChartObject










For i = 2 To 65
    wks.Cells(i, 31) = 0
Next i




Select Case mon_option1
Case "Point Initial"
    date_col = 6
    debut_ligne = 8
    For Each wks_source In wbk_source.Worksheets
        If Mid(wks_source.Name, 1, 4) = "Risk" Then
                   
                    mes_valeurs(1) = wks_source.Cells(debut_ligne, date_col + 1)
                    mes_valeurs(2) = wks_source.Cells(debut_ligne, date_col + 2)
                    mes_valeurs(3) = wks_source.Cells(debut_ligne, date_col + 3)


                    i = trouve_ligne(mes_valeurs)


                    wks.Cells(i, 31) = wks.Cells(i, 31) + 1


        End If
    Next
Case Else
    If mon_option2 = "Proposed" Then
                    date_col = 4
                    debut_ligne = 26
                Else
                    date_col = 4
                    debut_ligne = 48
    End If
   
    For Each wks_source In wbk_source.Worksheets
   
        If Mid(wks_source.Name, 1, 4) = "Risk" Then
                 
                  k = debut_ligne - 1
                  While wks_source.Cells(k + 1, date_col) > 0 And wks_source.Cells(k + 1, date_col) <= CDbl(CDate(mon_option1))
                    k = k + 1
                  Wend
                 
                  If k > debut_ligne - 1 Then
                    mes_valeurs(1) = approx_val(wks_source.Cells(k, date_col + 1))
                    mes_valeurs(2) = approx_val(wks_source.Cells(k, date_col + 2))
                    mes_valeurs(3) = approx_val(wks_source.Cells(k, date_col + 3))


                    i = trouve_ligne(mes_valeurs)


                    wks.Cells(i, 31) = wks.Cells(i, 31) + 1
                    Else
                    mes_valeurs(1) = approx_val(wks_source.Cells(8, 6 + 1))
                    mes_valeurs(2) = approx_val(wks_source.Cells(8, 6 + 2))
                    mes_valeurs(3) = approx_val(wks_source.Cells(8, 6 + 3))


                    i = trouve_ligne(mes_valeurs)
                   
                    wks.Cells(i, 31) = wks.Cells(i, 31) + 1
                   
                  End If


        End If
    Next
End Select


max_nb = 0
For i = 2 To 65
   max_nb = IIf((max_nb >= wks.Cells(i, 31)), max_nb, wks.Cells(i, 31))
Next i


For i = 1 To 10 Step 3
Set mon_graph = wks.ChartObjects("Detect_" & CStr(i))
If max_nb > 1 Then
mon_graph.Chart.Axes(xlValue).MaximumScale = max_nb
Else
mon_graph.Chart.Axes(xlValue).MaximumScale = 1
End IfIf mon_graph.Chart.Axes(xlValue).MajorUnit 0.5 Then mon_graph.Chart.Axes(xlValue).MajorUnit 1
Next i
wbk_source.Close
mon_AppEx.Quit
End Sub

-------------------------------------------------------------------------------------------------------------------

Sub Remplissage_tableau()
Dim wbk As Workbook
Dim wks As Worksheet
Set wbk = ThisWorkbook
Set wks = wbk.Worksheets("3D_AllRisks")


For i = 1 To 4
For j = 1 To 4
wks.Cells(57 + i, 14 + j) = 0
Next j
Next i




For i = 1 To 4
For j = 1 To 4
k = 2
While k <= 65If wks.Cells(k, 27) wks.Cells(57 + i, 14) And wks.Cells(k, 28) wks.Cells(57, 14 + j) Then wks.Cells(57 + i, 14 + j) = wks.Cells(57 + i, 14 + j) + wks.Cells(k, 31)
k = k + 1
Wend


Next j
Next i
End Sub

OUi en fait il faudrait un contrôle qui dise tant que l'execution du bouton n'est pas terminée je copie pas sur un slide...mais je sais pas si c'est possible....

Une question : VBA n'est pas séquentiel alors????
Merci dans tous les cas
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008

Merci pour tous tes conseils !!!
Je vais tester ça dans la journée...
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008

mais encore une question :
dans public sub MAJ_Click j'initialise AddSlide à False et à la fin je la mets à True? et après je fais le if AddSlide=True ...?
merci
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008

Bon apparemment VBA ne veut rien entendre avec




Public Sub MAJ_Click(Optional ByVal AjoutDiapo As Boolean)


Il me met une erreur de compilation comme si un bouton Click ne pouvait pas avoir de paramètres d'entrée...
Messages postés
539
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
14 juillet 2010
1
regarde a cette addresse je te le laisse une journée sur le serveur orange.
http://pagesperso-orange.fr/reveida/Book1.xls
je peux pas vérifier si le fichier est bien uploadé je suis chooté par le firewall de mon entreprise.
Je te conseil de mettre ton MAJ_click dans un module. dans ce fichier je l'ai mis dans thisworkbook
et j'ai créé un module1 avec dedans un sub pour tester l'argument a true
c'est simple, mais cela marche. et au final cela fera:
Private Sub CommandButton1_Click()
     Graph_3D_Marc_Ini
    MAJ_Click true
End Sub
@+
youpi :)
Messages postés
539
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
14 juillet 2010
1
si tu y arrives toujours pas envoi moi ton fichier excel s'il est po trop gros par mail, si tu es ok je t'enverai l'addr par MP.
@+
youpi :)
Messages postés
11
Date d'inscription
lundi 4 août 2008
Statut
Membre
Dernière intervention
16 octobre 2008

merci bcp youpiyoyo...je vais tester ça et je te tiens au courant