XL 2010 Erreur 1004, definie par l'application ou l'objet, dans une boucle

Nicko29

XLDnaute Nouveau
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:
WsDM.Cells(j, ColReg) = WsREAL.Cells(L, c).Value

code 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
 

Nicko29

XLDnaute Nouveau
Oui , ci-joint le tableau sans macro.

C'est exact je n'ai pas prévu l'éventualité ou L peut être Nothing. C peut effectivement être -1 aussi,

lorsque cela bloque, J = 256 ,ColReg = 16, L = 343 et c = "4"

la est surement le problème C = "4" au lieu de 4
J'ai repassé les lignes
Code:
c = Right(DM, 1)...
en
Code:
c = CInt(Right(DM, 1))
et j'ai corrigé l'erreur.
Reste que mon code n'est pas optimisé , je vais corriger çà pour C et L
 

Pièces jointes

  • table .xlsx
    901 KB · Affichages: 55
Dernière édition:

Nicko29

XLDnaute Nouveau
Je bloque sur L, comment sortir de la marco si L is nothing ?

Code:
L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row

ca nr marche pas comme ca :
Code:
set L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row
puis Traiter la valeur de L cela ne marche avec le
Code:
.row
à la fin
 

Paf

XLDnaute Barbatruc
re,

en supprimant .Row
Code:
set L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False)

puis
Code:
If Not L is Nothing Then
     'on récupère la ligne par L.Row
Else
     msgbox " Non trouvé"
     Exit Sub
End If


A+
 

Discussions similaires

Réponses
4
Affichages
1 K

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG