Problème base de données

Fermé
Lordknight Messages postés 5 Date d'inscription vendredi 4 juillet 2014 Statut Membre Dernière intervention 23 juillet 2014 - Modifié par noctambule28 le 10/07/2014 à 12:06
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 10 juil. 2014 à 12:02
Bonjour,
Je suis un train de faire un programme et, à un moment, il est censé recherché une référence dans une base de données qui lui permet aussi de rafraichir une série d'informations dans le fichier excel créé. De plus, justg avant de rechercher la référence, il vérifie si celle-ci se trouve déjà dans le fichier Excel qui recueille les informations et, si c'est le cas, il vérifie si le numéro de commande associé n'a pas déjà été entré dans le fichier excel et, si c'est le cas, il renvoie un message d'erreur.

Quand je lui demande de rafraichir les références il le fait bien, mais quand il doit lancer l'analyse du fichier, il me donne une incompatibilité de type. J'ai fait quelques tests sur le fichier à Analyser et il s'est révélé que cette erreur était lié au numéro de référence du produit, et je n'arrive pas à comprendre pourquoi cette erreur à lieu?

Est-ce que ce serait lié à la base de données?

Quelqu'un pourrait-il m'aider ?

Voici déjà le code qui vérifie la présence de la référence dans le fichier excel :

Sub checknew()

' Verifier si il n y a pas de doublon dans la base


' On Error GoTo oups1


Dim b As String
Dim a As Integer



nbrrec = 0
quancop = 0
quantitot = 0
b = UserForm5.TextBox32.Value


For a = 1 To nbligne
If UserForm5.TextBox2.Value = com(a) Then nbrrec = nbrrec + 1
    If b = qnum(a) And nbrec(a) = 1 And quan(a) <> "" Then
    quancop = quancop + CLng(quan(a))
   quantitot = quantitot + CLng(quan(a))
    End If
    If COPcheck(a) = True Then quancop = 0
Next a


If nbrrec <> 0 Then
MsgBox ("Attention , cette commande a déja été enregistrée " + CStr(nbrrec) + " fois")
End If

Select Case nbrrec
Case 0
UserForm5.Label57.ForeColor = 0
UserForm5.Label57.Caption = "New"
Case Else
UserForm5.Label57.ForeColor = 255
UserForm5.Label57.Caption = CStr(nbrrec)
End Select

Select Case quancop
Case Is > 5000
UserForm5.Label58.ForeColor = 255
UserForm5.Label58.Caption = CStr(quancop)
Case Else
UserForm5.Label58.ForeColor = 0
UserForm5.Label58.Caption = CStr(quancop)
End Select

If b = "-" Then
UserForm5.Label58.ForeColor = 0
UserForm5.Label58.Caption = "No Qust"
UserForm5.Label59.Caption = "-"
Else
UserForm5.Label59.Caption = CStr(quantitot)

End If


Exit Sub

'oups1:
'MsgBox (a)


End Sub


Celui qui met à jour les références du fichier selon la base de données

Sub loaddata()


' -------------------------------------------------------------------
' -     Mémorisation des données Fiches Produits à partir du ficher TXT
' -------------------------------------------------------------------

fixparameter



Erase rangeds
Erase refds
Erase coulds
Erase fourds
Erase qustds
Dim a As Integer
Dim b As String
Dim d As Integer
Dim c As Integer



Open DCLacces For Input As #2
a = 1
Do Until EOF(2) = True
    Line Input #2, b
    Erase posiv
    d = 1
    For c = 1 To VBA.Len(b)
        If VBA.Mid(b, c, 1) = ";" Then
            posiv(d) = c
             d = d + 1
        End If
    Next c
    rangeds(a) = VBA.Mid(b, 1, posiv(1) - 1)
    refds(a) = VBA.Mid(b, posiv(1) + 1, posiv(2) - posiv(1) - 1)
    nomrefds(a) = VBA.Mid(b, posiv(2) + 1, posiv(3) - posiv(2) - 1)
    coulds(a) = VBA.Mid(b, posiv(3) + 1, posiv(4) - posiv(3) - 1)
    fourds(a) = VBA.Mid(b, posiv(4) + 1, posiv(5) - posiv(4) - 1)
    qustds(a) = VBA.Mid(b, posiv(5) + 1, VBA.Len(b) - posiv(5))

    a = a + 1
Loop
nbdsref = a - 1
Close #2

End Sub


Et enfin la partie du workbooks qui traite la recherche de la abse de données :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

' 1 -  Déclaration de variable
Dim wshshell As Object
Dim dclacces1
Dim tempacces
Dim tempacces1
Dim lig As Integer
Dim range1
Dim adress
Dim h
Dim fs


Set wshshell = CreateObject("WScript.Shell")

DCLacces = "N:\Cormier-Qualite\Private\QUALITE CORMIER\Database\DECOShip.bdd"
dclacces1 = "N:\Cormier-Qualite\Private\QUALITE CORMIER\Database\DBlienrapport.bdd"
tempacces = wshshell.SpecialFolders(16) & "\DCLtemp.bdd"
tempacces1 = wshshell.SpecialFolders(16) & "\lientemp.bdd"

lig = 5

' 2 - Suppression du filtre automatique de la feuille Data
        If Sheets("Data").AutoFilterMode = True Then Sheets("Data").AutoFilterMode = False


' 3 - Ecriture Fichier de données vers repertoire Qualité Dorel Cormier

Dim char As String


Open tempacces For Output As 1
Open tempacces1 For Output As 2

Do Until Sheets("Data").Cells(lig, 1) = ""
        range1 = "O" + CStr(lig)
        For Each h In Range(range1).Hyperlinks
            adress = h.Address
        Next
adress = "N:\Cormier-Qualite\Private\QUALITE CORMIER\14 - SHIPMENT REPORT\" + adress 'CStr(Right(adress, Len(adress) - 5))
char = CStr(Sheets("Data").Cells(lig, 4)) + "~" + CStr(adress) + VBA.Chr(13)
Write #2, char 'Sheets("Data").Cells(lig, 4); "~"; CStr(adress); VBA.Chr(13)

If Sheets("Data").Cells(lig, 12) <> "" Then

char = CStr(Sheets("Data").Cells(lig, 1)) + "~" + CStr(Sheets("Data").Cells(lig, 4)) + "~" + CStr(Sheets("Data").Cells(lig, 12)) + "~" + CStr(adress) + VBA.Chr(13) '; Chr(13) 'Sheets("Data").Cells(lig, 15); Chr(13)
Print #1, char 'Sheets("Data").Cells(lig, 1); "~"; Sheets("Data").Cells(lig, 4); "~"; Sheets("Data").Cells(lig, 12); "~"; CStr(adress) '; Chr(13) 'Sheets("Data").Cells(lig, 15); Chr(13)
End If

lig = lig + 1
Loop

Close #1
Close #2

Set fs = CreateObject("Scripting.FileSystemObject")
fs.copyfile tempacces, DCLacces, True
fs.copyfile tempacces1, dclacces1, True

'fs.deletefile tempacces, True
'fs.deletefile tempacces1, True



End Sub

Quelqu'un peut-il m'aider?


1 réponse

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
10 juil. 2014 à 12:02
Bonjour,

Sans vos fichiers deja pas simple, mais sans la ligne en erreur pas possible
0