Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

erreur de compilation

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

kabale53

XLDnaute Occasionnel
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
 
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 ?
 
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...)
 
Dernière édition:
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 🙂
 
Re : erreur de compilation

Re

Après avoir lu ceci
(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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
258
wDog66
W
Réponses
1
Affichages
162
Réponses
23
Affichages
680
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…