erreur de compilation

kabale53 · 29 Décembre 2013

Bonsoir
J'ai un fichier excel 2007 avec une macro.
J'ai 2 pc.
Sur le 1er pc la macro fonctionne normalement.
Sur le 2eme pc ,je n'arrive pas a exécuter l'application:j'obtiens l'erreur de compilation "membre de méthode ou de données introuvables"
Pourriez-vous m'expliquer pourquoi le meme fichier fonctionne sur le 1er pc et non sur le 2eme et bien sur si c'est possible comment remédier a cela.
Merci

Staple1600 · 29 Décembre 2013

Re : erreur de compilation

Bonsoir à tous

kabale53
Sans voir le fichier incriminé
(ou tout du moins le code VBA utilisé)
ça va être difficile de dire pourquoi, non ?

Tu peux joindre une copie (anonymisée) de ton fichier ici ?

kabale53 · 29 Décembre 2013

Re : erreur de compilation

Re,
Merci Staple1600 pour l'interet porté a ma demande d'aide.

avec mes remerciements

Staple1600 · 29 Décembre 2013

Re : erreur de compilation

Re

Merci pour le fichier mais peux-tu joindre ton ficher en version *.xls
(car actuellement je ne dispose que d'un pc avec Excel 2003)

PS: Le convertisseur n'arrive pas le convertir en *.xls (ce qui est de mauvais augure...)

RONIBO · 29 Décembre 2013

Re : erreur de compilation

Bonsoir,

De mon coté j'ai pas d'erreur, tout fonctionne parfaitement 🙂

Bonne nuit

Staple1600 · 29 Décembre 2013

Re : erreur de compilation

Re

RONIBO
Tu as Excel 2007 moi 2003
Ceci explique cela 😉

RONIBO · 29 Décembre 2013

Re : erreur de compilation

Salut Staple1600,

Mais ou est passée la version 2013 ? 🙂

Staple1600 · 30 Décembre 2013

Re : erreur de compilation

Re

A ton avis? Elle chez moi.
Et ici je ne suis pas chez moi (vacances obligent) 😉

Donc j'attends d'avoir un *.xls pour voir le code VBA.

RONIBO · 30 Décembre 2013

Re : erreur de compilation

re,

Bonne vacance 🙂

J'en profite pour te fêter une bonne fête de fin d'année à toi et ta famille 🙂

J'ai essayé de convertir le fichier en xls, mais mon Excel plante...

Staple1600 · 30 Décembre 2013

Re : erreur de compilation

Re

RONIBO
Donc tout ne fonctionne pas si bien 😉
Ce que je pressentais 😉

PS: Le convertisseur n'arrive pas le convertir en *.xls (ce qui est de mauvais augure)

QUESTION: Le code VBA est-il conséquent ? Y-a-til un userform?

RONIBO · 30 Décembre 2013

Re : erreur de compilation

Re,

Il y a plusieurs code (Vu que j'ai pas d'erreurs cela va être difficile de les identifier, en tout cas pour moi🙂 )
Non il n'y a pas USF !

Voici les codes
Feuil1

Code:

Option Explicit

Private Sub CBut_Hier_Click()
    CBox_Course.Visible = False
    CBut_Extraire.Visible = False
    Call Import_Course(Format(Date - 1, "yyyy-mm-dd"))
    PronoDate = Format(Date - 1, "dd") & "/" & _
                Format(Date - 1, "mm") & "/" & _
                Format(Date - 1, "yyyy")
    Call Get_Pronos
    CBox_Course.Visible = True
End Sub

Private Sub CBut_Aujourdhui_Click()
    CBox_Course.Visible = False
    CBut_Extraire.Visible = False
    Call Import_Course(Format(Date, "yyyy-mm-dd"))
    PronoDate = Format(Date, "dd") & "/" & _
                Format(Date, "mm") & "/" & _
                Format(Date, "yyyy")
    Call Get_Pronos
    CBox_Course.Visible = True
End Sub

Private Sub CBut_Demain_Click()
    CBox_Course.Visible = False
    CBut_Extraire.Visible = False
    Call Import_Course(Format(Date + 1, "yyyy-mm-dd"))
    PronoDate = Format(Date + 1, "dd") & "/" & _
                Format(Date + 1, "mm") & "/" & _
                Format(Date + 1, "yyyy")
    Call Get_Pronos
    CBox_Course.Visible = True
End Sub

Private Sub CBut_Extraire_Click()
    Call Carriere
    Call Cote
    Call DWQ
    CBut_Extraire.Visible = False
    MsgBox "      Extraction Terminée !    "
End Sub

Private Sub CBox_Course_Click()
    Range("A1").Activate
    With CBox_Course
        If IsNull(.List(.ListIndex, 2)) Then Exit Sub
        Range("B9").CurrentRegion.EntireRow.Delete
        F03.Cells.Delete
        Application.ScreenUpdating = False
        Call Get_Course(.List(.ListIndex, 3))
        Cells(8, 2) = UCase(.List(.ListIndex, 2)) & "_____" & _
                      UCase(.List(.ListIndex, 1)) & "_____" & _
                      UCase(.List(.ListIndex, 0))
        Cells(8, 2).Font.Bold = True
    End With
    Call Get_Musique
    With Range("B8").CurrentRegion
        .WrapText = False
        .Columns.AutoFit
    End With
    CBut_Extraire.Visible = True
    Application.ScreenUpdating = True
End Sub

Module 1 :

Code:

Option Explicit

Sub Import_Course(URL_Date As String)
' **************************************
' * Nécessite d'activer les références *
' *   Microsoft HTML Objects Library   *
' *    Microsoft Internet Controls     *
' **************************************
    Dim IE As InternetExplorer
    Dim IEDOC As HTMLDocument
    Dim OLink As Object
    Dim vUrl As String
    Dim T As String, Tablo

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False

    IE.navigate "http://www.geny.com/reunions-courses-pmu/_d" & URL_Date & "?"
    WaitIE IE

    Set IEDOC = IE.document
    vUrl = "http://www.geny.com/partants-pmu/"

    'Récupérer URL des Courses
    With ActiveSheet.CBox_Course
        .Clear
        .ColumnCount = 3
        .BoundColumn = 3
        .Style = fmStyleDropDownList
        .AddItem "< Choisir une course >"
        .Visible = True
        DoEvents
        For Each OLink In IEDOC.Links
            Application.StatusBar = "Extraction Liste des Courses"
            If OLink.href Like vUrl & "*" Then
                T = Mid(OLink.href, Len(vUrl) + 1)
                T = Left(T, InStrRev(T, "_") - 1)
                Tablo = Split(T, "-pmu-")
                .AddItem Application.Proper(Tablo(1))
                .List(.ListCount - 1, 1) = Application.Proper(Split(Tablo(0), URL_Date & "-")(1))
                .List(.ListCount - 1, 2) = URL_Date
                .List(.ListCount - 1, 3) = OLink.href
            End If
        Next OLink
        .ListIndex = 0
        Application.StatusBar = ""
    End With

    Set IEDOC = Nothing
    IE.Quit
    Set IE = Nothing

End Sub

Module 2 :

Code:

Option Explicit
Public WebCourse As String
Public WebCote As String
Public NotLogin As Boolean
Public PronoDate As String

Sub DWQ()
    Do While ActiveWorkbook.Connections.Count > 0
        ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
    Loop
End Sub

Sub WaitIE(IE As InternetExplorer)
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:02"))
    DoEvents
End Sub

Module 3 :

Code:

Option Explicit

Sub Carriere()
    Dim Cel As Range
    Dim Nom_Ch As String

    Application.ScreenUpdating = False

    F03.Cells.Delete
    If NotLogin Then WebCourse = "4" Else WebCourse = "3"

    For Each Cel In Range("C10:C" & Cells(Rows.Count, 2).End(xlUp).Row)
        With Cel
            If .Hyperlinks.Count <> 0 Then
                Nom_Ch = Split(Split(.Hyperlinks(1).Address, "/")(4), "_")(0)
                Application.StatusBar = "Extraction Cheval : " & Nom_Ch
                Call GetCourse(Cel.Row, Nom_Ch, .Hyperlinks(1).Address)
            End If
        End With
    Next Cel

    Application.StatusBar = False
    Set Cel = Nothing
    F03.Cells.Columns.AutoFit
    Application.ScreenUpdating = True

End Sub

Sub GetCourse(lig As Long, Nom As String, Lien As String)
    With F03
        lig = (lig - 10) * 10 + 1
        .Cells(lig, 1) = Nom
        .Cells(lig, 1).Font.ColorIndex = 3
        .Cells(lig, 1).Font.Bold = True
        With .QueryTables.Add( _
             Connection:="URL;" & Lien, _
             Destination:=.Cells(lig + 1, 1))
            .BackgroundQuery = False
            .RefreshStyle = xlOverwriteCells
            .WebSelectionType = xlSpecifiedTables
            .WebTables = WebCourse
            .TablesOnlyFromHTML = True
            .WebDisableDateRecognition = True
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
    End With
End Sub

Module 4 :

Code:

Option Explicit

Sub Cote()
' **************************************
' * Nécessite d'activer les références *
' *   Microsoft HTML Objects Library   *
' *    Microsoft Internet Controls     *
' **************************************
    Dim IE As InternetExplorer
    Dim IEDOC As HTMLDocument
    Dim IEpartant As IHTMLDivElement
    Dim IEelement As IHTMLElementCollection
    Dim Tablo As IHTMLTable, idx As Byte
    Dim Texte() As String
    Dim i As Integer, j As Integer

    Dim Cel As Range
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    Application.ScreenUpdating = False

    With F03
        For Each Cel In .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
            Application.StatusBar = "Extraction Cotes et Nbre Partants : " & _
                                    Int(100 * Cel.Row / .Cells(.Rows.Count, 1).End(xlUp).Row) & " %"
            With Cel
                If .Hyperlinks.Count <> 0 Then
                    If .Offset(-1).Hyperlinks.Count = 0 Then
                        .Offset(-1, 12).AutoFill Destination:=.Offset(-1, 12).Resize(1, 3)
                        .Offset(-1, 13) = "Cotes": .Offset(-1, 14) = "Partants"
                    End If
                    .Offset(, 12).AutoFill Destination:=.Offset(, 12).Resize(1, 3)
                    IE.navigate .Hyperlinks(1).Address
                    WaitIE IE
                    
                    Set IEDOC = IE.document
                    Set IEelement = IEDOC.getElementsByTagName("table")
                    If NotLogin Then idx = 1 Else idx = 0
                    Set Tablo = IEelement(idx)
                    For j = 1 To Tablo.Rows(0).Cells.Length
                        If Tablo.Rows(0).Cells(j - 1).innerText Like "Cote*" Then idx = j - 1: Exit For
                    Next j
                    For i = 1 To Tablo.Rows.Length
                        For j = 1 To Tablo.Rows(i - 1).Cells.Length
                            If InStr(Tablo.Rows(i - 1).Cells(j - 1).innerHTML, Split(.Hyperlinks(1).Address, "_h")(1)) <> 0 Then
                                If InStr(Tablo.Rows(i - 1).Cells(idx).innerText, "/") <> 0 Then
                                    '.Offset(, 13) = Trim(Split(Tablo.Rows(i - 1).Cells(idx).innerText, "/")(0))
                                    .Offset(, 13) = Evaluate(Replace(Tablo.Rows(i - 1).Cells(idx).innerText, ",", "."))
                                Else
                                    .Offset(, 13) = ""
                                    .Offset(, 15) = "Cote Fictive"
                                End If
                            End If
                        Next j
                    Next i
                    Set IEpartant = IEDOC.getElementById("fc")
                    For i = 0 To IEpartant.Children.Length - 1
                        If InStr(IEpartant.Children.Item(i).innerText, "Partant") <> 0 Then
                            Texte = Split(Split(IEpartant.Children.Item(i).innerText, "Partant")(0), "-")
                            .Offset(, 14) = Trim(Texte(UBound(Texte)))
                            If .Offset(, 13) = "" Then
                                With .Offset(, 15)
                                    .Value = "Cote Fictive": .Font.Bold = True: .Font.ColorIndex = 3
                                End With
                                Select Case UCase(.Offset(, 10))
                                Case 1, 2
                                    .Offset(, 13) = 5
                                Case 3, 4
                                    .Offset(, 13) = 10
                                Case 5 To 8
                                    .Offset(, 13) = 15
                                Case "DAI"
                                    .Offset(, 13) = 7
                                Case "NP"
                                    .Offset(, 13) = IIf(2 * .Offset(, 14) > 35, 35, 2 * .Offset(, 14))
                                Case Else
                                    .Offset(, 13) = 12
                                End Select
                            End If
                            Exit For
                        End If
                    Next i
                End If
            End With
        Next Cel
        Application.ScreenUpdating = True
        Application.StatusBar = ""
        .Columns("N:N").AutoFit
    End With

    Set IEelement = Nothing
    Set IEDOC = Nothing
    IE.Quit
    Set IE = Nothing

End Sub

Module 5 :

Code:

Option Explicit

Sub Get_Course(Lien As String)
    With F01
        With .QueryTables.Add( _
             Connection:="URL;" & Lien, _
             Destination:=.Range("B8"))
            .BackgroundQuery = True
            .RefreshStyle = xlOverwriteCells
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "1"
            .TablesOnlyFromHTML = True
            .WebDisableDateRecognition = True
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
        If .Range("C8") = "E-mail" Then
            NotLogin = True
            With .QueryTables.Add( _
                 Connection:="URL;" & Lien, _
                 Destination:=.Range("B8"))
                .BackgroundQuery = True
                .RefreshStyle = xlOverwriteCells
                .WebSelectionType = xlSpecifiedTables
                .WebTables = "2"
                .TablesOnlyFromHTML = True
                .WebDisableDateRecognition = True
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With
        End If
    End With
End Sub

Module 6 :

Code:

Option Explicit

Sub Get_Musique()
' **************************************
' * Nécessite d'activer les références *
' *   Microsoft HTML Objects Library   *
' *    Microsoft Internet Controls     *
' **************************************
    Dim IE As InternetExplorer
    Dim IEDOC As HTMLDocument
    Dim IEelements As IHTMLElement
    Dim IEelement As IHTMLElement
    Dim Cel As Range, Plage As Range
    Dim C As Range

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False

    With F01
        Set C = .Range("B9:L9").Find("musique", LookIn:=xlValues)
        Set Plage = .Range(Cells(10, C.Column), Cells(.Cells(.Rows.Count, C.Column).End(xlUp).Row, C.Column))

        For Each Cel In Plage
            Application.StatusBar = "Extraction Musique : " & Cel.Row - 9 & _
                                    " de " & Plage.Rows.Count
            With Cel
                If .Hyperlinks.Count <> 0 Then
                    IE.navigate .Hyperlinks(1).Address
                    WaitIE IE
                    
                    Set IEDOC = IE.document
                    Set IEelements = IEDOC.getElementById("fc")
                    For Each IEelement In IEelements.Children
                        If IEelement.tagName = "H3" Then
                            .Value = Trim(IEelement.innerText)
                            Exit For
                        End If
                    Next IEelement
                End If
            End With
        Next Cel
        Application.StatusBar = ""
    End With

    Set IEelements = Nothing
    Set IEDOC = Nothing
    Set Plage = Nothing
    Set C = Nothing
    IE.Quit
    Set IE = Nothing

End Sub

Module 7 :

Code:

Option Explicit

Sub Tablo_NCV()
    Dim lig As Byte
    With F05
        F04.Range("B6:U10").Copy
        .Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
        .Range("H6:L25").FormulaR1C1 = "=1*OFFSET(Performances!R1C14,COLUMN()-6+(ROW()-6)*10,0,1,1)"
        .Range("M6:Q25").FormulaR1C1 = "=OFFSET(Performances!R1C11,COLUMN()-11+(ROW()-6)*10,0,1,1)"
        .Range("R6:V25").FormulaR1C1 = "=OFFSET(Performances!R1C15,COLUMN()-16+(ROW()-6)*10,0,1,1)"
        .Range("W6:AA25").FormulaR1C1 = "=OFFSET(Performances!R1C10,COLUMN()-21+(ROW()-6)*10,0,1,1)"
        With .Range("H6:AA25")
            .Copy
            .PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
        .Range("A1").Activate
    End With
    Call Favoris
    Call SYO5
    Call LPT5
    Call SYOLPT

    For lig = 1 To 20
        If Application.WorksheetFunction.Sum(Range("H5").Offset(lig).Resize(1, 20)) < 1 Then _
           Range("H5").Offset(lig).Resize(1, 20).ClearContents
    Next lig

End Sub

Sub Favoris()
    Dim Colc As Byte, Colf As Byte, Col As Byte
    Col = 6
    Range("F27:V27").ClearContents
    Do
        For Colf = 6 To 11
            If Application.WorksheetFunction.CountIf(Range("F27:V27"), Cells(Colf, "F")) = 0 Then
                Cells(27, Col) = Cells(Colf, "F")
                Col = Col + 1
                Exit For
            End If
        Next Colf
        For Colc = 6 To 11
            If Application.WorksheetFunction.CountIf(Range("F27:V27"), Cells(Colc, "C")) = 0 Then
                Cells(27, Col) = Cells(Colc, "C")
                Col = Col + 1
                Exit For
            End If
        Next Colc
    Loop Until (Colc > 11 And Colf > 11)
End Sub

Sub SYO5()
    Dim Colf As Byte
    Range("F28:V28").ClearContents
    For Colf = 12 To 22
        If Cells(Colf, "G") >= 5 Then
            Cells(28, Colf - 6) = Cells(Colf, "F")
        End If
    Next Colf
End Sub

Sub LPT5()
    Dim Colc As Byte
    Range("F29:V29").ClearContents
    For Colc = 12 To 22
        If Cells(Colc, "D") >= 5 Then
            Cells(29, Colc - 6) = Cells(Colc, "C")
        End If
    Next Colc
End Sub

Sub SYOLPT()
    Dim Colc As Byte, Colf As Byte, Col As Byte
    Col = 6
    Range("F30:V30").ClearContents
    Do
        For Colf = 12 To 25
            If Application.WorksheetFunction.CountIf(Range("F30:V30"), Cells(Colf, "F")) = 0 And Cells(Colf, "G") >= 5 Then
                Cells(30, Col) = Cells(Colf, "F")
                Col = Col + 1
                Exit For
            End If
        Next Colf
        For Colc = 12 To 25
            If Application.WorksheetFunction.CountIf(Range("F30:V30"), Cells(Colc, "C")) = 0 And Cells(Colc, "D") >= 5 Then
                Cells(30, Col) = Cells(Colc, "C")
                Col = Col + 1
                Exit For
            End If
        Next Colc
    Loop Until (Colc > 25 And Colf > 25)
End Sub

Module 8 :

Code:

Option Explicit

Sub Get_Pronos()
' **************************************
' * Nécessite d'activer les références *
' *   Microsoft HTML Objects Library   *
' *    Microsoft Internet Controls     *
' **************************************
    Dim IE As InternetExplorer
    Dim IEDOC As HTMLDocument
    Dim IEsubmit As IHTMLElement
    Dim IEelement As IHTMLElementCollection
    Dim Tablo As IHTMLTable
    Dim i As Integer, j As Integer

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    Application.StatusBar = "Récupération Pronos de la Presse"

    IE.navigate "http://www.pronostics-turf.info/courses/archives.php"
    WaitIE IE

    Set IEDOC = IE.document
    Set IEsubmit = IEDOC.getElementById("text_field")
    IEsubmit.Value = PronoDate
    Set IEsubmit = IEDOC.forms(0)
    IEsubmit.submit
    WaitIE IE

    Set IEDOC = IE.document
    Set IEelement = IEDOC.getElementsByTagName("table")
    Set Tablo = IEelement(IEelement.Length - 1)

    With F04
        .Cells.Delete
        For i = 1 To Tablo.Rows.Length
            For j = 1 To Tablo.Rows(i - 1).Cells.Length
                With .Cells(i + 4, j)
                    .Value = Trim(Tablo.Rows(i - 1).Cells(j - 1).innerText)
                    .ColumnWidth = 3.5
                    .HorizontalAlignment = xlCenter
                    .Font.Bold = True
                    .BorderAround LineStyle:=xlContinuous, Weight:=xlThin
                End With
            Next j
        Next i
        .Columns("A:A").AutoFit
        Set IEelement = IEDOC.getElementsByTagName("blockquote")
        If IEelement.Length > 4 Then
            .Cells(2, 1) = IEelement(4).all.Item(1).innerText
            .Cells(3, 1) = IEelement(4).all.Item(2).innerText
            With F01
                .Cells(1, 11) = "Quinté : " & Split(IEelement(4).all.Item(1).innerText, "RÉSULTATS DU ")(1)
                .Cells(2, 11) = IEelement(4).all.Item(2).innerText
            End With
        Else
            .Cells.Delete
            .Cells(2, 1) = "Désolé, cette course n'a pas encore été mise sur le serveur..."
            With F01
                .Cells(1, 11) = "Désolé, le Quinté n'a pas "
                .Cells(2, 11) = "encore été mis sur le serveur..."
            End With
        End If
    End With

    Application.StatusBar = ""
    Set Tablo = Nothing
    Set IEelement = Nothing
    Set IEsubmit = Nothing
    Set IEDOC = Nothing
    IE.Quit
    Set IE = Nothing

End Sub

Et dernièrement le TW :

Code:

Option Explicit

Private Sub Workbook_Open()
    With [F01]
        .CBut_Extraire.Visible = False
        .CBox_Course.Visible = False
    End With
End Sub

Si ca peut t'avancer un peu 🙂

Staple1600 · 30 Décembre 2013

Re : erreur de compilation

Re

Après avoir lu ceci

L’ensemble de ce site relève des législations française et internationale sur le droit d’auteur et la propriété intellectuelle.
Tous les droits de reproduction sont réservés, y compris pour les documents iconographiques et photographiques.
La reproduction de tout ou partie de ce site sur un support électronique quel qu’il soit est formellement interdite sauf autorisation expresse du directeur de la publication.

(source: Mentions légales et copyright)

Je n'irai pas plus loin pour ma part.

PS1: DavidXLD, si tu passes par là...

PS2: RONIBO: Désolé de t'avoir mis à contribution mais merci d'avoir éclairer ma lanterne en postant le code VBA

kabale53 · 30 Décembre 2013

Re : erreur de compilation

Bonjour Staple1600;
Bonjour RONIBO

Jai retiré le fichier en question (droit de reproduction du site sur un support electronique).
Par ailleurs,l'erreur de compilation était due a une dll manquante sur le 2eme pc dont la simple réparation a pu résoudre le probleme.
Cordialement

Effectuez une recherche sur Excel Downloads...

erreur de compilation

kabale53

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

kabale53

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

RONIBO

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

RONIBO

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

RONIBO

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

RONIBO

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

kabale53

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée