Le compilateur saute des instructions dans le code

Résolu/Fermé
muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017 - Modifié le 27 oct. 2017 à 12:18
muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017 - 27 oct. 2017 à 16:32
Bonjour,
je bloque sur un problème et je ne sais plus quoi faire surtout qu'aucune erreur n'est signalée. dans mon code vba tout va bien jusqu'au moment où un bloc d'intructions est considéré invisible par le compilateur. tout ce qui est autour marche sans problème mon code est ci dessous
Option Base 1
 Sub FilesStandardization()
     
     '*******************Sélection des fichiers, ouverture ,suppression de colonnes ,rangement et changement d'extension*******************
     
      
    Dim Wbk As Workbook, iprF As Workbook, iprCC As Workbook
    Dim file, Quelfichier() As Variant
    Dim n, m, ctr, a As Long, b As Long
    Dim cmpt1 As Long, cmpt2 As Long
    Dim NameLastcolF As String, NameLastcolCC As String, ast As String, bst As String
    Dim ColTitleF(), ColTitleCC() As Variant
    
    Application.ScreenUpdating = False
    'Sélection et ouverture des fichiers
    'S'assurer que les fichiers sont classés par ordre alphabétique
    Quelfichier = Application.GetOpenFilename("Excel Files (*.csv), *.csv", 2, "Sélection des fichiers", , True)
   
    'If Quelfichier <> True Then
        'Displaying a message if file not choosed in the above step
        'MsgBox "File not Found.", vbExclamation, "!! Warning !!"
        'Exit Sub
    'End If
    Application.ScreenUpdating = False
    For ctr = 1 To UBound(Quelfichier)
        Set Wbk = Workbooks.Open(Filename:=Quelfichier(ctr))
     Next ctr
     For Each Wbk In Workbooks
        If Wbk.Name = "IPR Fields.csv" Then
           Set iprF = Wbk
        End If
        If Wbk.Name = "IPR Fields - Complete and Closure State.csv" Then
            Set iprCC = Wbk
        End If
    Next Wbk
    'For ctr = 1 To UBound(Quelfichier)
     '   If ctr = 1 Then
      '      Set iprCC = Workbooks.Open(Filename:=Quelfichier(ctr))
       ' Else
        '    Set iprF = Workbooks.Open(Filename:=Quelfichier(ctr))
       ' End If
    'Next ctr
    'suppression de colonnes
    'iprF.Activate
    'Range("B1:B80227,E1:E80227,G1:G80227,L1:L80227,O1:O80227,P1:P80227,Q1:Q80227,R1:R80227,U1:U80227,V1:V80227,X1:X80227,Y1:Y80227,Z1:Z80227").Select
    'Selection.EntireColumn.Delete
    'Range("P1:P80227,Q1:Q80227,T1:T80227,W1:W80227,AA1:AA80227,AB1:AB80227,AC1:AC80227,AD1:AD80227,AE1:AE80227,AG1:AG80227,AK1:AK80227,AL1:AL80227,AM1:AM80227").Select
    'Selection.EntireColumn.Delete
    'Range("AA1:AA80227,AB1:AB80227,AE1:AE80227,AK1:AK80227,AM1:AM80227,AN1:AN80227,AO1:AO80227,AP1:AP80227,AR1:AR80227,AT1:AT80227,AU1:AU80227,AV1:AV80227,AW1:AW80227,AX1:AX80227,AZ1:AZ80227").Select
    'Selection.EntireColumn.Delete
    'Range("AL1:AL80227,AM1:AM80227,AN1:AN80227,AO1:AO80227,AQ1:AQ80227,AR1:AR80227,AS1:AS80227,AZ1:AZ80227,BB1:BB80227,BC1:BC80227,BD1:BD80227,BF1:BF80227,BG1:BG80227,BI1:BI80227,BJ1:BJ80227").Select
    'Selection.EntireColumn.Delete
    'Range("AW1:AW80227,AX1:AX80227,AZ1:AZ80227,BA1:BA80227,BB1:BB80227,BC1:BC80227,BD1:BD80227,BE1:BE80227,BG1:BG80227,BH1:BH80227,BI1:BI80227,BJ1:BJ80227").Select
    'Selection.EntireColumn.Delete
    
    'iprF.RefreshAll
    iprF.Activate
    ColTitleF = Range("A1:BC1")
    
    iprCC.Activate
    ColTitleCC = Range("A1:DS1")
   
   ## For cmpt1 = LBound(ColTitleF, 2) To cmpt1 = UBound(ColTitleF, 2)
        If ColTitleF(1, cmpt1) <> ColTitleCC(1, cmpt1) Then
            For cmpt2 = LBound(ColTitleCC, 2) To cmpt2 = UBound(ColTitleCC, 2)
                If ColTitleF(1, cmpt1) = ColTitleCC(1, cmpt2) Then
                    Call Permut(cmpt1, cmpt2)
                    Exit For
                End If
            Next
        End If
   ## Next
  
    'iprCC.RefreshAll
    
    'iprF.SaveAs FileFormat:=xlNormal
    'iprF.Close Savechanges:=True
    'iprCC.SaveAs FileFormat:=xlNormal
    'iprCC.Close Savechanges:=True

End Sub
    
Sub Permut(Col1 As Long, Col2 As Long)
        Dim c1 As Long, c2 As Long
        iprCC.Activate
        c1 = IIf(Col1 < Col2, Col1, Col2)
        c2 = IIf(Col1 > Col2, Col1, Col2)
        Application.ScreenUpdating = False
        Columns(c2).Copy
        Columns(c1).Insert
        Columns(c1 + 1).Cut Cells(1, c2 + 1)
        Columns(c1 + 1).Delete
End Sub

le bloc sauté est celui entre les ##, j'ai mis le reste de code (qui marche sans pb)en commentaires pour pouvoir aller direct au pb. les "lbound" et "ubound" contiennent bien les bornes des tableaux respectifs.

Aidez moi svp.

EDIT : Ajout du langage dans les balises de code (pour avoir la coloration syntaxique )

A voir également:

1 réponse

jordane45 Messages postés 38144 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 21 avril 2024 4 650
27 oct. 2017 à 12:21
Bonjour,

As tu essayé de le faire en mode pas à pas pour voir ce qui se passe exactement.
As tu, en mode pas à pas, regardé les valeurs que prennent tes différentes variables pour savoir si elles correspondent bien à ce que tu attends ?

Et.. à mon avis :
For cmpt1 = LBound(ColTitleF, 2) To cmpt1 = UBound(ColTitleF, 2)

est à remplacer par :
For cmpt1 = LBound(ColTitleF, 2) To  UBound(ColTitleF, 2)

1
jordane45 Messages postés 38144 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 21 avril 2024 4 650
Modifié le 27 oct. 2017 à 12:22
Idem pour cmpt2
For cmpt2 = LBound(ColTitleCC, 2) To  UBound(ColTitleCC, 2)
0
muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017
Modifié le 27 oct. 2017 à 14:18
Merci Jordane45 ça marche.
merci.
une question stp je souhaiterai afficher une boîte de dialogue si la sélection de fichier n'est pas bien effectuée mais la condition ne marche pas (peut être parce que je sélectionne 2 fichiers) mais je voudrais savoir si c'est possible
'If Quelfichier <> True Then
'Displaying a message if file not choosed in the above step
'MsgBox "File not Found.", vbExclamation, "!! Warning !!"
'Exit Sub
'End If
0
jordane45 Messages postés 38144 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 21 avril 2024 4 650 > muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017
27 oct. 2017 à 14:37
Normalement.... on ne pose qu' UNE question par discussion.

Mais bon.. pour cette fois....

Déjà.. ton code est en commentaire.... normal que ça ne marche pas.
Ensuite... as tu essayé, en mode pas à pas, de regarder quelle était la valeur de ta variable Quelfichier ??


NB: Pense à cliquer sur le lien "SUJET RESOLU" qui se trouve sous le titre de ta question.
0
muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017 > jordane45 Messages postés 38144 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 21 avril 2024
Modifié le 27 oct. 2017 à 16:33
Oui je sais qu'il est en commentaire je voulais d'abord faire le plus important.
Oui j'ai compilé pas à pas mais ça me génère une erreur et dit que les types ne correspondent pas:"type mismatch"
0