Pb d'ordre d'execution de procéduresRésolu

Question

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...

youpiyoyo · Accepted Answer

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 :)

pm78000 · Answer

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

youpiyoyo · Answer

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 :)

youpiyoyo · Answer

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 :)

pm78000 · Answer

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

youpiyoyo · Answer

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 :)

pm78000 · Answer

Merci pour tous tes conseils !!!
Je vais tester ça dans la journée...

pm78000 · Answer

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

pm78000 · Answer

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...

youpiyoyo · Answer

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 :)

youpiyoyo · Answer

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 :)

pm78000 · Answer

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

Pb d'ordre d'execution de procédures

12 réponses

Votre réponse

Discussions similaires