Bonjour,
Je peine à me corriger, j'ai une erreur 1004 qui se produit dans une boucle du code, alors que le code marche et boucle correctement sur une dizaine de ligne puis plante. sur cette ligne.
J'ai l'impression que j'ai loupé un truc, je ne suis pas non plus un pro VBA.
Une idée ? je tourne en rond.
code entier :
Je peine à me corriger, j'ai une erreur 1004 qui se produit dans une boucle du code, alors que le code marche et boucle correctement sur une dizaine de ligne puis plante. sur cette ligne.
J'ai l'impression que j'ai loupé un truc, je ne suis pas non plus un pro VBA.
Une idée ? je tourne en rond.
Code:
WsDM.Cells(j, ColReg) = WsREAL.Cells(L, c).Valuecode entier :
Code:
Option Explicit
Public Const F_DM = "Table_Echange"
Public Const F_UINT = "Export_UINT"
Public Const F_UINTBCD = "Export_UINT_BCD"
Public Const F_REAL = "Export_REAL"
Public Const F_MAJ = "SUIVI_MODIF"
Public Const F_LEG = "LEGENDE"
Public Const Ndepart = 2
Public Const Categorie1 = "Télé-Réglage"
Public Const Categorie2 = "Recette"
Public Const T_UINT = "UINT"
Public Const T_UINT_BCD = "UINT HEXA"
Public Const T_REAL = "REAL"
Public Const NomColCategorie = "CATEGORIE"
Public Const NomColType = "TYPE"
Public Const NomColDM = "ADRESSE FINS"
Public Const NomColREG = "Réglages"
Public ColCat As Integer
Public ColType As Integer
Public ColDM As Integer
Public ColReg As Integer
Function RecupCol()
Dim WsDM As Worksheet
Set WsDM = ThisWorkbook.Worksheets(F_DM)
On Error GoTo ErrorHandler
ColCat = WsDM.Cells.Find(What:=NomColCategorie, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Column
ColType = WsDM.Cells.Find(What:=NomColType, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Column
ColDM = WsDM.Cells.Find(What:=NomColDM, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Column
ColReg = WsDM.Cells.Find(What:=NomColREG, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Column
GoTo FIN
ErrorHandler:
MsgBox " Vérifier l'orthographe des noms d'entête des colonnes " & NomColCategorie & " , " & NomColType & " , " & NomColDM & " , " & NomColREG & " , puis relancer l'opération "
FIN:
End Function
Sub Importation_DM()
Dim d As Long
Dim A, B As String
Dim i, j, L, c, cpt As Integer
Dim ldm As Variant
Dim DM As Variant
Dim WsDM As Worksheet
Dim WsUnit As Excel.Worksheet
Dim WsUBCD As Excel.Worksheet
Dim WsREAL As Excel.Worksheet
'====== attribue une référence d'objet à la variable.
Set WsDM = Application.ThisWorkbook.Worksheets(F_DM)
Set WsUnit = Application.ThisWorkbook.Worksheets(F_UINT)
Set WsUBCD = Application.ThisWorkbook.Worksheets(F_UINTBCD)
Set WsREAL = Application.ThisWorkbook.Worksheets(F_REAL)
'===== appel macro Récupération de numéro de olonne
RecupCol
'===== boucle pour tester l'existence et le nom des feuilles
For i = 1 To ThisWorkbook.Worksheets.Count
Select Case ThisWorkbook.Worksheets(i).Name
Case F_DM, F_UINT, F_UINTBCD, F_REAL, F_MAJ, F_LEG
' elle est présente
Case Else
MsgBox "La Feuille " & ThisWorkbook.Worksheets(i).Name & " est inexistante ou mal orthographiée "
GoTo arret
End Select
Next i
'====== Conversion en nombre de la feuille real
For j = 2 To 6
WsREAL.Columns(j).TextToColumns FieldInfo:=Array(1, 1)
WsREAL.Columns(j).NumberFormat = "000.0"
Next j
'====== boucle qur la feuille "Table_echange" pour trovuer les DM en fonction de la catégorie et type ( format)
'd = WsDM.Range("G" & Rows.Count).End(xlUp).Row ' récupération de la dernière ligne remplie
d = WsDM.Cells(Columns(ColDM).Cells.Count, 1).End(xlUp).Row
For j = Ndepart To d
A = WsDM.Cells(j, ColCat).Value
B = WsDM.Cells(j, ColType).Value ' B = WsDM.Range("F" & j).Value
DM = WsDM.Cells(j, ColDM).Value 'DM = WsDM.Range("G" & j).Value
'Test si case DM vide ou s'il comporte un nombre différent de caractères
If Len(DM) = 0 Then
MsgBox "Absence de DM dans la cellule , colonne " & ColDM & " Ligne " & j
GoTo LigneSuiv
ElseIf (A = Categorie1 Or A = Categorie2) And Len(DM) < 4 Then
MsgBox "Nom de DM incorrect dans la cellule : colonne " & ColDM & " Ligne " & j
MsgBox Len(DM)
WsDM.Cells(j & ColDM).Interior.Color = 65535 ' coloriage de la cellule incorrect pour repère
GoTo LigneSuiv
Else
End If
If (A = Categorie1 Or A = Categorie2) And B = T_UINT Then ' filter les DM par catégorie1 (Télé-Réglage) et catégorie2 (recette) et type ( UINT)
' Recupération UINT
ldm = Mid(DM, 2, Len(DM) - 2) * 10 ' récupération de la valeur de DM sans l'unité ( et la premiere lettre D, pour la recherche de la ligne
c = Right(DM, 1) + 2
L = WsUnit.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Row ' recherche de la ligne du DM
WsDM.Cells(j, ColReg) = WsUnit.Cells(L, c).Value
cpt = cpt + 1
ElseIf (A = Categorie1 Or A = Categorie2) And B = T_UINT_BCD Then ' filter les DM par catégorie1 (Télé-Réglage) et catégorie2 (recette)et type ( UINT_BCD)
' Recupération UINT_BCD
ldm = Mid(DM, 2, Len(DM) - 2) * 10 'récupération de la valeur de DM sans l'unité ( et la premiere lettre D, pour la recherche de la ligne
c = Right(DM, 1) + 2
L = WsUBCD.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Row ' recherche de la ligne du DM
WsDM.Cells(j, ColReg) = WsUBCD.Cells(L, c).Value
cpt = cpt + 1
ElseIf (A = Categorie1 Or A = Categorie2) And B = T_REAL Then ' filter les DM par catégorie1 (Télé-Réglage)et catégorie2 (recette) et type ( REAL
' Recupération REAL
ldm = Mid(DM, 2, Len(DM) - 2) * 10 'récupération de la valeur de DM sans l'unité ( et la premiere lettre D, pour la recherche de la ligne
c = Right(DM, 1) ' on récupéré l'unité du DM
'test l'unité du DM est impair
If c Mod 2 <> 0 Then 'si c impair
MsgBox " DM incorrect : valeur impair dans la cellule G" & j
WsDM.Cells(j & ColDM).Interior.Color = 65535 ' coloriage de la cellule incorrect pour repère
GoTo LigneSuiv
Else 'si c pair
'on fait rien on continue
End If
Select Case c ' calcul de la colonne diférent en fonction de l'unité du DM
Case 0
c = c + 2
Case 2
c = c + 1
Case 4
c = c
Case 6
c = c - 1
Case 8
c = c - 2
Case Else
End Select
L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Row ' recherche de la ligne du DM
WsDM.Cells(j, ColReg) = WsREAL.Cells(L, c).Value
cpt = cpt + 1
Else
End If
LigneSuiv:
Next j
MsgBox cpt & " paramètres ont été importé"
arret:
Set WsDM = Nothing
Set WsUnit = Nothing
Set WsUBCD = Nothing
Set WsREAL = Nothing
End Sub