Discussion :

[nhug1]

Je sais que le titre est nul mais vous allez vite comprendre mon problème. J'ai fait un petit programme qui me permet de rechercher dans tous les fichiers excel et powerpoint des données (word est en cours). Pour excel ça va à la vitesse de la lumière mais pour powerpoint je n'arrive pas à faire une sorte de Application.screenupdating = false donc à chaque fois il load tout le fichier, l'affiche puis il effectue la recherche puis il le ferme... Et cela prend un temps monstre!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
 
Sub TraitementPowerpoint(ByVal NomDossierSource, ByVal wb)
 
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
 
Set pptApp = CreateObject("PowerPoint.Application")
 
 
Set pptPres = pptApp.Presentations.Open(NomDossierSource & "/" & wb.Name)
Dim oSld As Slide
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
 
    With pptApp
        .DisplayAlerts = False
    End With
 
       For Each oSld In pptPres.Slides
           For Each oshp In oSld.Shapes
                If oshp.HasTextFrame Then
                        For i = 0 To UBound(tbl)
                            Set oTxtRng = oshp.TextFrame.TextRange
                            Set ofoundText = oTxtRng.Find(tbl(i))
                                Do While Not (ofoundText Is Nothing)
                                   With ofoundText
                                        With workbook_source.Sheets(2)
 
                                               .Cells(r, 2).Value = NomDossierSource
                                               .Cells(r, 3).Value = pptPres.Name
                                               .Cells(r, 4).Value = oSld.Name
                                               .Cells(r, 5).Value = oSld.SlideIndex
                                               .Cells(r, 6).Value = tbl(i)
                                               .Cells(r, 1).Value = "ouvrir"
                                               .Hyperlinks.Add Anchor:=.Cells(r, 1), Address:=.Cells(r, 2).Value & .Cells(r, 3).Value & "#" & .Cells(r, 5).Value
 
                                        End With
 
                                      Set ofoundText = oTxtRng.Find(tbl(i), After:=.Start + .Length - 1)
                                   End With
                                   r = r + 1
                                Loop
                        Next i
                End If
           Next oshp
       Next oSld
 
 
pptApp.Quit
Set pptApp = Nothing
Set pptPres = Nothing
 
 
End Sub

Si vous avez des idées, je suis vraiment preneur

bon week end les amis

[Menhir]

Non seulement cette question aurait du être posée dans la rubrique Macro et VBA mais elle aurait du être posée dans celle de Access.

[nhug1]

bonjour,

(c'est d'ailleurs, "bonjour", ce qui manquait dans votre message cher menhir.)

Effectivement, mon topic aurait dû être dans macro VBA et excel mais je ne vois absolument le rapport avec Access.

Cordialement,


nhug

[Menhir]

c'est d'ailleurs, "bonjour", ce qui manquait dans votre message cher menhir.)

Ca manquait aussi dans ton message.

je ne vois absolument le rapport avec Access.

Je voulais dire PowerPoint.
http://www.developpez.net/forums/f68...ba-powerpoint/

[joe.levrai]

Bonjour,

via les API visiblement : http://skp.mvps.org/ppt00033.htm

non testé !

dis-nous si ça fonctionne, pour les futurs lecteurs cherchant une solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
' --------------------------------------------------------------------------------
' Copyright ©1999-2015, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or 
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------
' UserDefined Error codes
Const ERR_NO_WINDOW_HANDLE As Long = 1000
Const ERR_WINDOW_LOCK_FAIL As Long = 1001
Const ERR_VERSION_NOT_SUPPORTED As Long = 1002
 
' API declarations for FindWindow() & LockWindowUpdate()
' Use FindWindow API to locate the PowerPoint handle. 
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, _
       ByVal lpWindowName As Long) As Long
 
' Use LockWindowUpdate to prevent/enable window refresh
Declare Function LockWindowUpdate Lib "user32" _
      (ByVal hwndLock As Long) As Long 
' Use UpdateWindow to force a refresh of the PowerPoint window  
Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
 
Property Let ScreenUpdating(State As Boolean)
      Static hwnd As Long
      Dim VersionNo As String
      ' Get Version Number
      If State = False Then
 
        VersionNo = Left(Application.Version, _
                    InStr(1, Application.Version, ".") - 1)
 
' Get handle to the main application window using ClassName
        Select Case VersionNo
        Case "8"  ' For PPT97:
            hwnd = FindWindow("PP97FrameClass", 0&)
        Case "9"  ' For PPT2K:
            hwnd = FindWindow("PP9FrameClass", 0&)
        Case "10" ' For XP:
            hwnd = FindWindow("PP10FrameClass", 0&)
        Case "11" ' For 2003:
            hwnd = FindWindow("PP11FrameClass", 0&)
        Case "12" ' For 2007:
            hwnd = FindWindow("PP12FrameClass", 0&)
        Case "14" ' For 2010:
            hwnd = FindWindow("PPTFrameClass", 0&)
        Case "15" ' For 2013:
            hwnd = FindWindow("PPTFrameClass", 0&)
        Case Else
            Err.Raise Number:=vbObjectError + ERR_VERSION_NOT_SUPPORTED, _
            Description:="Newer version."
            Exit Property
        End Select
 
        If hwnd = 0 Then
            Err.Raise Number:=vbObjectError + ERR_NO_WINDOW_HANDLE, _
            Description:="Unable to get the PowerPoint Window handle"
            Exit Property
        End If
 
        If LockWindowUpdate(hwnd) = 0 Then
            Err.Raise Number:=vbObjectError + ERR_WINDOW_LOCK_FAIL, _
            Description:="Unable to set a PowerPoint window lock"
            Exit Property
        End If
 
      Else
        ' Unlock the Window to refresh
        LockWindowUpdate (0&)
        UpdateWindow (hwnd)
        hwnd = 0
 
      End If
End Property
 
'Sample Usage:
Sub LongProcessingSub()
' Lock screen redraw
ScreenUpdating=False
' --- Long time consuming code
' Redraw screen again
ScreenUpdating=True
' Also see below article for another example of usage of the code
End Sub

Attention si ta suite office est 64Bits, faudra adapter les déclarations Functions

[nhug1]

Bonjour joe.levrai,


merci pour ce code, je teste dès que j'ai une minute de libre et je reviendrais bien évidemment pour dire si cela à fonctionné.


merci encore :-)

[wawdsa]

Bonjour,

Je déterre ce post puisque j'ai le même problème mais je ne sais pas comment utiliser/activer ce code en fait..

Merci d'avance !

[Menhir]

http://bidou.developpez.com/article/VBA/
http://silkyroad.developpez.com/VBA/DebuterMacros/

[wawdsa]

Merci,

Quelqu'un aurait-il une aide plus précise que ces deux liens ?

[clementmarcotte]

Juste à paramétrer les options d'indexation de Windows pour indexer les bons dossiers et rechercher dans les fichiers.

Une fois l'index complété, tu recherches avec Windows au lieu de prendre des macros.

Et puis, si tu as Outlook sur ta machine, il y a des chances que tu puisses utiliser Outlook pour faire ta recherche. Au pire tu transférerais tes résultats dans Excel après...