Lordknight
Messages postés5Date d'inscriptionvendredi 4 juillet 2014StatutMembreDernière intervention23 juillet 2014
-
Modifié par noctambule28 le 10/07/2014 à 12:06
f894009
Messages postés17185Date d'inscriptiondimanche 25 novembre 2007StatutMembreDernière intervention15 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