Erreur compilation type défini par l'utilisateur non défini

fredounette -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous,

je recup un bd filemaker pro 5.5 pour integration sous excel
j'ai le message ci-dessous et je n'arrive pas à me dépatouiller, pouvez vous m'aider.

Dim FMApp As FMPRO50Lib.Application
Dim FMDocs As FMPRO50Lib.Documents
Dim FMActiveDoc As FMPRO50Lib.Document
Dim DBConn As ADODB.Connection
Dim dbfields As Collection
Dim FMFields As Collection

Private Const DB_DATE_FICHE = "Lot Date"
Private Const DB_LOT_FICHE = "Lot Fiche"
Private Const DB_CODE_ARTICLE = "Code Article"
Private Const DB_DESCR = "Description"
Private Const DB_POIDS = "Poids"
Private Const DB_LOT_ARTICLE = "Lot Article"
Private Const DB_PRIX = "Nuance"
Private Const DB_QTE = "Quantité"

Private FMSEP As String

Public Sub FMOpen()
Set FMApp = New FMPRO50Lib.Application
Set FMDocs = FMApp.Documents
End Sub

Private Function FMDocOpen(fileName As String) As FMPRO50Lib.Document
Set FMDocOpen = FMDocs.Open(fileName, "")
End Function

Private Sub FMDocClose(ByRef doc As FMPRO50Lib.Document)
doc.Close
Set doc = Nothing
End Sub

Private Sub FMClose()
FMDocs.Close
Set FMDocs = Nothing
FMApp.Quit
Set FMApp = Nothing
End Sub

Public Sub FMImport()
initFieldsLists
FMSEP = Chr(29)
DBOpen
FMOpen
Dim doc As FMPRO50Lib.Document
Dim fileName As String
Dim tableName As String
fileName = configGetValue("FMFAB")
Set doc = FMDocOpen(fileName)

doc.DoFMScript ("Export_FAB")
While FMApp.ScriptStatus <> 0
DoEvents
Wend
FMDocClose doc
FMClose

Dim hdl As Integer
Dim buffer As String

hdl = FreeFile
Open ThisWorkbook.Path & "\Export_FAB.tab" For Input As hdl
Dim fields() As String
While Not EOF(hdl)
Line Input #hdl, buffer
fields = Split(buffer, vbTab)
FMProcessRecord fields
Wend
Close hdl
DBClose
End Sub

Private Sub FMProcessRecord(fields() As String)
Static lastFiche As String
Static lastDate As String
Dim codes() As String
Dim descrs() As String
Dim poids() As String
Dim lots() As String
Dim prix() As String
Dim qte() As String
Dim fdate As String
Dim flot As String
Dim rs As New Recordset
Dim fieldsname As Variant
Dim ifield
If fields(0) = "" Then Exit Sub
While Asc(fields(0)) > 122: fields(0) = Mid(fields(0), 2): Wend
If StrComp(Trim(fields(0)), "SUITE", vbTextCompare) = 0 Or Trim(fields(0)) = "" Then
fdate = lastDate
flot = lastFiche
Else
fdate = Replace(Left(fields(0), 10), ".", "/")
lastDate = fdate
flot = fields(1)
lastFiche = flot
rs.Open "DELETE * FROM LotLignes WHERE [Lot Fiche]='" & flot & "'", DBConn, adOpenDynamic, adLockOptimistic
End If
Dim nb As Integer
codes = Split(fields(2), FMSEP)
nb = UBound(codes)
descrs = Split(fields(4), FMSEP)
poids = Split(fields(6), FMSEP)
lots = Split(fields(3), FMSEP)
prix = Split(fields(5), FMSEP)
qte = Split(fields(7), FMSEP)

fieldsname = Array(DB_DATE_FICHE, DB_LOT_FICHE, DB_CODE_ARTICLE, DB_DESCR, DB_POIDS, DB_LOT_ARTICLE, DB_PRIX, DB_QTE)

rs.Open "LotLignes", DBConn, adOpenKeyset, adLockOptimistic

Dim values As Variant
Dim i As Integer
Dim fpoids As String, flots As String, fdescrs As String, fprix As String, fqte As Double

For i = 0 To UBound(codes)
If Trim(codes(i)) <> "" Then
If i > UBound(descrs) Then fdescrs = "" Else fdescrs = Trim(descrs(i))
If i > UBound(poids) Then fpoids = "" Else fpoids = Trim(poids(i))
If i > UBound(lots) Then flots = "" Else flots = Trim(lots(i))
If i > UBound(prix) Then fprix = "" Else fprix = Trim(prix(i))
If i > UBound(qte) Then
fqte = "0"
ElseIf Trim(qte(i)) = "" Then
fqte = "0"
Else
fqte = CleanQte(qte(i))
End If

values = Array(CDate(fdate), flot, Trim(codes(i)), _
CStr(fdescrs), _
CStr(fpoids), _
CStr(flots), _
CStr(fprix), _
CDbl(fqte))
rs.AddNew fieldsname, values
rs.Update
End If
Next
rs.Close
End Sub
Private Function CleanQte(value As String) As String
Dim i As Integer
Dim result As String
Dim c As Integer
Dim h As Boolean

h = False
For i = 1 To Len(value)
c = Asc(Mid(value, i, 1))
If (c >= 48 And c <= 57) Then
result = result & Chr(c)
ElseIf c = 46 And h = False Then
result = result & "."
h = True
End If
Next
If result = "" Then result = "0"
CleanQte = result
End Function
Private Function configGetValue(key As String) As String
Dim tabConf As Range
Set tabConf = Range("TabConfig")
Dim c As Range
Set c = tabConf.Columns(1).Find(key)
configGetValue = tabConf.Cells(c.row, 3)
End Function

Private Sub configSetValue(key As String, value As Variant)
Dim tabConf As Range
Set tabConf = Range("TabConfig")
Dim c As Range
Set c = tabConf.Columns(1).Find(key)
tabConf.Cells(c.row - 1, 3).value = value
End Sub

Private Sub initFieldsLists()
Set FMFields = New Collection
Set dbfields = New Collection
FieldsListsAdd configGetValue("FMDATE"), DB_DATE_FICHE
FieldsListsAdd configGetValue("FMLOTFICHE"), DB_LOT_FICHE
FieldsListsAdd configGetValue("FMARTICLE"), DB_CODE_ARTICLE
FieldsListsAdd configGetValue("FMDESCR"), DB_DESCR
FieldsListsAdd configGetValue("FMPOIDS"), DB_POIDS
FieldsListsAdd configGetValue("FMLOTACTION"), DB_LOT_ARTICLE
FieldsListsAdd configGetValue("FMPRIX"), DB_PRIX
FieldsListsAdd configGetValue("FMQTE"), DB_QTE
End Sub

Private Sub FieldsListsAdd(FMField As String, DBField As String)
FMFields.Add FMField, DBField
dbfields.Add DBField, FMField
End Sub

Private Function configGetLastFiche()
configGetLastFiche = configGetValue("FMLASTFICHE")
End Function

Private Sub configSetLastFiche(value As String)
configSetValue "FMLASTFICHE", value
End Sub

Private Sub DBOpen()
Set DBConn = New ADODB.Connection
Dim Dsn As String
Dsn = "DRIVER=Microsoft Access Driver (*.mdb, *.accdb);" & vbCrLf & _
"DBQ=" & ThisWorkbook.Path & "\" & configGetValue("DBMDB")
DBConn.Open Dsn
End Sub

Private Sub DBClose()
DBConn.Close
Set DBConn = Nothing
End Sub

Public Sub FMImportUI()
Load UserForm1
UserForm1.Show
End Sub

merci

7 réponses

  1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    Merci de mettre tes codes entre les balises <> pour une meilleure lisibilité: tu fais un copier du code original puis


    Tu ne nous dit pas sur quelle ligne se déclenche l'erreur : elle doit ^tre surlignée en jaune

    tu écris
    je recup un bd filemaker pro 5.5 pour integration sous excel
    Tu te connectes à une base access ?

    as tu coché les références ADODB dans l'éditeur VBA (outils-références)?
    Microsoft activeX data objects 2.N (N:dépend version Excel)
    et
    Microsoft activeX data objects Recorset

    mais ton code est très difficile à lire....

    Je n'ai pas vu la suppression de la collection
    set lacollection=nothing

    enfin on ne voit peu de restitution de données dans Excel....

    Michel
    0
  2. fredounette
     
    Bonjour, merci de m'aider a résoudre mon pbm.
    je ne me connecte pas à une base access
    je recup les données de FM vers excel pour traiter mes informations, articles, lots, détails... afin de connaitre les qtés fabriqué pour chaque article au mois ou à l'année

    je suis novice, je récup le bb qui a été créé par mon prédécesseur et qui ne fonctionne plus à la suite d'un changement de PC.

    Réf ADODB coché :
    visual basic for applications
    Microsoft excel 15.0 object Library
    OLE automation
    Microsoft office 15.0 object Library
    micsrosoft activex data objects 2.7 Library
    Microsoft forms 2.0 object Library
    MANQUANT : filemaker pro 5.0 type Library (je l'ai décoché mais tjs meme message)

    Dim FMApp As FMPRO50Lib.Application
    Dim FMDocs As FMPRO50Lib.Documents
    Dim FMActiveDoc As FMPRO50Lib.Document
    Dim DBConn As ADODB.Connection
    Dim dbfields As Collection
    Dim FMFields As Collection

    Private Const DB_DATE_FICHE = "Lot Date"
    Private Const DB_LOT_FICHE = "Lot Fiche"
    Private Const DB_CODE_ARTICLE = "Code Article"
    Private Const DB_DESCR = "Description"
    Private Const DB_POIDS = "Poids"
    Private Const DB_LOT_ARTICLE = "Lot Article"
    Private Const DB_PRIX = "Nuance"
    Private Const DB_QTE = "Quantité"

    Private FMSEP As String

    Public Sub FMOpen()
    Set FMApp = New FMPRO50Lib.Application
    Set FMDocs = FMApp.Documents
    End Sub

    Private Function FMDocOpen(fileName As String) As FMPRO50Lib.Document
    Set FMDocOpen = FMDocs.Open(fileName, "")
    End Function

    Private Sub FMDocClose(ByRef doc As FMPRO50Lib.Document)
    doc.Close
    Set doc = Nothing
    End Sub

    Private Sub FMClose()
    FMDocs.Close
    Set FMDocs = Nothing
    FMApp.Quit
    Set FMApp = Nothing
    End Sub

    Public Sub FMImport()
    initFieldsLists
    FMSEP = Chr(29)
    DBOpen
    FMOpen
    Dim doc As FMPRO50Lib.Document
    Dim fileName As String
    Dim tableName As String
    fileName = configGetValue("FMFAB")
    Set doc = FMDocOpen(fileName)

    doc.DoFMScript ("Export_FAB")
    While FMApp.ScriptStatus <> 0
    DoEvents
    Wend
    FMDocClose doc
    FMClose

    Dim hdl As Integer
    Dim buffer As String

    hdl = FreeFile
    Open ThisWorkbook.Path & "\Export_FAB.tab" For Input As hdl
    Dim fields() As String
    While Not EOF(hdl)
    Line Input #hdl, buffer
    fields = Split(buffer, vbTab)
    FMProcessRecord fields
    Wend
    Close hdl
    DBClose
    End Sub

    Private Sub FMProcessRecord(fields() As String)
    Static lastFiche As String
    Static lastDate As String
    Dim codes() As String
    Dim descrs() As String
    Dim poids() As String
    Dim lots() As String
    Dim prix() As String
    Dim qte() As String
    Dim fdate As String
    Dim flot As String
    Dim rs As New Recordset
    Dim fieldsname As Variant
    Dim ifield
    If fields(0) = "" Then Exit Sub
    While Asc(fields(0)) > 122: fields(0) = Mid(fields(0), 2): Wend
    If StrComp(Trim(fields(0)), "SUITE", vbTextCompare) = 0 Or Trim(fields(0)) = "" Then
    fdate = lastDate
    flot = lastFiche
    Else
    fdate = Replace(Left(fields(0), 10), ".", "/")
    lastDate = fdate
    flot = fields(1)
    lastFiche = flot
    rs.Open "DELETE * FROM LotLignes WHERE [Lot Fiche]='" & flot & "'", DBConn, adOpenDynamic, adLockOptimistic
    End If
    Dim nb As Integer
    codes = Split(fields(2), FMSEP)
    nb = UBound(codes)
    descrs = Split(fields(4), FMSEP)
    poids = Split(fields(6), FMSEP)
    lots = Split(fields(3), FMSEP)
    prix = Split(fields(5), FMSEP)
    qte = Split(fields(7), FMSEP)

    fieldsname = Array(DB_DATE_FICHE, DB_LOT_FICHE, DB_CODE_ARTICLE, DB_DESCR, DB_POIDS, DB_LOT_ARTICLE, DB_PRIX, DB_QTE)

    rs.Open "LotLignes", DBConn, adOpenKeyset, adLockOptimistic

    Dim values As Variant
    Dim i As Integer
    Dim fpoids As String, flots As String, fdescrs As String, fprix As String, fqte As Double

    For i = 0 To UBound(codes)
    If Trim(codes(i)) <> "" Then
    If i > UBound(descrs) Then fdescrs = "" Else fdescrs = Trim(descrs(i))
    If i > UBound(poids) Then fpoids = "" Else fpoids = Trim(poids(i))
    If i > UBound(lots) Then flots = "" Else flots = Trim(lots(i))
    If i > UBound(prix) Then fprix = "" Else fprix = Trim(prix(i))
    If i > UBound(qte) Then
    fqte = "0"
    ElseIf Trim(qte(i)) = "" Then
    fqte = "0"
    Else
    fqte = CleanQte(qte(i))
    End If

    values = Array(CDate(fdate), flot, Trim(codes(i)), _
    CStr(fdescrs), _
    CStr(fpoids), _
    CStr(flots), _
    CStr(fprix), _
    CDbl(fqte))
    rs.AddNew fieldsname, values
    rs.Update
    End If
    Next
    rs.Close
    End Sub
    Private Function CleanQte(value As String) As String
    Dim i As Integer
    Dim result As String
    Dim c As Integer
    Dim h As Boolean

    h = False
    For i = 1 To Len(value)
    c = Asc(Mid(value, i, 1))
    If (c >= 48 And c <= 57) Then
    result = result & Chr(c)
    ElseIf c = 46 And h = False Then
    result = result & "."
    h = True
    End If
    Next
    If result = "" Then result = "0"
    CleanQte = result
    End Function
    Private Function configGetValue(key As String) As String
    Dim tabConf As Range
    Set tabConf = Range("TabConfig")
    Dim c As Range
    Set c = tabConf.Columns(1).Find(key)
    configGetValue = tabConf.Cells(c.row, 3)
    End Function

    Private Sub configSetValue(key As String, value As Variant)
    Dim tabConf As Range
    Set tabConf = Range("TabConfig")
    Dim c As Range
    Set c = tabConf.Columns(1).Find(key)
    tabConf.Cells(c.row - 1, 3).value = value
    End Sub

    Private Sub initFieldsLists()
    Set FMFields = New Collection
    Set dbfields = New Collection
    FieldsListsAdd configGetValue("FMDATE"), DB_DATE_FICHE
    FieldsListsAdd configGetValue("FMLOTFICHE"), DB_LOT_FICHE
    FieldsListsAdd configGetValue("FMARTICLE"), DB_CODE_ARTICLE
    FieldsListsAdd configGetValue("FMDESCR"), DB_DESCR
    FieldsListsAdd configGetValue("FMPOIDS"), DB_POIDS
    FieldsListsAdd configGetValue("FMLOTACTION"), DB_LOT_ARTICLE
    FieldsListsAdd configGetValue("FMPRIX"), DB_PRIX
    FieldsListsAdd configGetValue("FMQTE"), DB_QTE
    End Sub

    Private Sub FieldsListsAdd(FMField As String, DBField As String)
    FMFields.Add FMField, DBField
    dbfields.Add DBField, FMField
    End Sub

    Private Function configGetLastFiche()
    configGetLastFiche = configGetValue("FMLASTFICHE")
    End Function

    Private Sub configSetLastFiche(value As String)
    configSetValue "FMLASTFICHE", value
    End Sub

    Private Sub DBOpen()
    Set DBConn = New ADODB.Connection
    Dim Dsn As String
    Dsn = "DRIVER=Microsoft Access Driver (*.mdb, *.accdb);" & vbCrLf & _
    "DBQ=" & ThisWorkbook.Path & "\" & configGetValue("DBMDB")
    DBConn.Open Dsn
    End Sub

    Private Sub DBClose()
    DBConn.Close
    Set DBConn = Nothing
    End Sub

    Public Sub FMImportUI()
    Load UserForm1
    UserForm1.Show
    End Sub
    0
  3. fredounette
     
    personne pour m'aider :):):):)
    0
  4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    MANQUANT : filemaker pro 5.0 type Library (je l'ai décoché mais tjs meme message) c'est peut_etre la que cela peche, est-ce que filemaker a ete installe sur le nouveau PC et quel OS avez-vous ???

    Decocher la ref manquante ne résout pas vraiment le probleme, vu qu'il la faut pour que ca marche
    0
    1. fredounette
       
      Bjr. Oui sur le nouveau poste est installe filemaker pro 5.5 et pc en win 7 pro 64 bit et office 2013... la recup souw excel avait ete développé avec un pc sous xp et office 2007.
      0
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Sur quelle lignes de programme il y a erreur ???
      0
    3. fredounette
       
      Justement, je sais pas. Aucune ligne en jaune
      0
    4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      Question: comment le programme est lance ??? un bouton sur une feuille, par une userform ???

      Pouvez-vous mettre des points d'arret dans le programme pour connaitre le deroulement du programme
      0
    5. fredounette
       
      Bjr,
      c'est un bouton sur une feuille Excel.
      0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. fredounette
     
    le bouton lance une userform
    0
  7. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    pour voir ou est l'erreur, il faut lancer directement l'userform en partant de le fenetre VBA. double click sur Userform et lancer par le triangle sous Insertion (menu en haut) et la vous verrez la ligne en jaune
    0
  8. fredounette
     
    Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    CommandButton1.Enabled = False
    FMImport
    CommandButton1.Enabled = True
    Application.ScreenUpdating = True
    Unload UserForm1

    End Sub

    1ère ligne en jaune....
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      si premiere ligne (Private ....) en jaune, c'est que vous avez clique sur le bouton, ca ne correspond pas a ce que vous avez d'ecrit au niveau de l'erreur Erreur compilation type défini par l'utilisateur non défini. Vous devez avoir le cas present un mot ou une instruction en surligne

      Est-il possible d'avoir votre fichier sans donnees confidentielles sur https://www.cjoint.com/
      0
    2. fredounette
       
      je suis complètement perdu, oui je vous transmets les fichiers...

      fichier excel, et ex bdd filemaker dans dossier zip

      http://www.cjoint.com/?3Dkrd1YuHaB
      0
    3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      Pas de panique, c'est ce que j'ai pense quand vous avez ecrit seven 64bits (je ne pense pas avoir eu la berlue): le repertoire C:\Programme Files systemes 32bits devient C:\Programme Files (x86) en systemes 64bits pour les logiciels 32bits

      ici recopies d'ecrans pour ref office voir Chemin d'acces et ref manquante voir chemin d'acces
      https://www.cjoint.com/?DDkrtoRSuBG

      il faut aller chercher la reference dans C:\Programme Files (x86)\FileMaker\FileMaker Pro 5.5\ ...


      j'ai eu l'erreur en lancement par le bouton: https://www.cjoint.com/?DDkrKjqFsXb
      0
    4. fredounette
       
      BRJ,

      toujours pareil de mon coté, je suis perdue... et j'en ai marre
      0
    5. fredounette
       
      j'ai beau refaire et refaire, je ne trouve pas d'erreur sur le script, je penche pour une dll manquante ???
      0