Conversion Variant to String : l'indice n'appartient pas à la sélection

[jbballeyguier]

Bonjour,

j'ai un petit soucis avec une macro.
L'idée est de faire une recherche de fichiers, d'ouvrir un par un les fichiers et de traiter les données dans ces fichiers. J'utilise la fonction filesearch, et je place le nom de chaque fichier dans un variant.
Le problème c'est que je voudrais récupérer le nom du fichier et le placer dans une variable string (j'ai l'impression que c'est plus simple à traiter.) Cependant, lorsque j'exécute la macro, il bute justement sur le passage de cette variant en string :

Ench = Cstr(NomFic)

Erreur : "l'indice n'appartient pas à la sélection"

Voilà la totalité du code :

Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Function ClipBoard_Clear()
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call CloseClipboard
End Function
Sub ploum()
    Call macro1
    Call Module2.InputPourRax
End Sub
Sub MaJ_PlandeTests()
    Dim ScanFic As Office.FileSearch
    Dim NomFic As Variant
    Dim racine As String
    Dim chemin As String
    Dim Ench As String
    Dim NomEnch As String
    Dim ligne As Integer

    ThisWorkbook.Worksheets("INPUT").Range("A2:Q12000").ClearContents
    ThisWorkbook.Worksheets("Suivi global").Range("C2:C500").ClearContents
    Application.CutCopyMode = False
    Set ScanFic = Application.FileSearch

ligne = 2
h = 1

    Do While ThisWorkbook.Sheets("Nomenclature").Cells(h, 1) <> ""
        ThisWorkbook.Activate
            Sheets("Nomenclature").Activate
            Cells(h, 1).Select
            racine = ThisWorkbook.Sheets("Nomenclature").Cells(h, 1)
            chemin = (ThisWorkbook.Path & "\" & racine)
            
    ' On recherche les fichiers dans l'arborescence et on les ouvre
            With ScanFic
                .NewSearch
                .LookIn = chemin
                .SearchSubFolders = True
                .FileType = msoFileTypeExcelWorkbooks
                .Execute
                
    ' On ouvre les fichiers trouvés et on les traite un par un
               For Each NomFic In .FoundFiles
                    Workbooks.Open Filename:=NomFic, UpdateLinks:=False
                    Ench = CStr(NomFic)
                    'MsgBox Ench
                    Workbooks(Ench).Activate
                    ActiveWorkbook.Sheets("CR détaillé").Activate
                    NomEnch = Range("C1").Value
                    'NomEnch = Workbooks(Ench).Sheets("CR détaillé").Range("C1").Value
        
        
    ' Effectue la copie des colonnes A à N
Dim j As Integer
j = 1
blanc = 0
                    Sheets("CR détaillé").Activate
                    Do While blanc < 2
                        If Worksheets("CR détaillé").Cells(j, 1) = "" Then blanc = blanc + 1
                        If Worksheets("CR détaillé").Cells(j, 1) <> "" Then blanc = 0
                        j = j + 1
                    Loop
                    MsgBox j
Dim fin As Integer
fin = 1
                    fin = j - 2
                    Cells(fin, 8).Value = "FIN"
                
    ' On supprime les lignes inutiles
                    Worksheets("CR Détaillé").Activate
                    Range(Cells(3, 15), Cells(fin, 15)).Value = NomEnch 'Met le numéro de l'enchainement dans la colonne O
                    j = 2
                        Do While Cells(j, 8).Value <> "FIN"
                        Cells(j, 8).Select
                        ' On se sert de la mise en forme des lignes que l'on veut supprimer, c'est bourrin mais ça marche
                            If Cells(j, 2).Interior.ColorIndex = 56 And Cells(j + 1, 1) = "" Then
                                Range(Cells(j, 1), Cells(j + 1, 15)).Select
                                Selection.Delete xlUp
                             ElseIf Cells(j, 1) = "" Or Cells(j, 2).Interior.ColorIndex = 16 Or Cells(j, 2).Interior.ColorIndex = 56 Then
                                Range(Cells(j, 1), Cells(j, 15)).Select
                                Selection.Delete xlUp
                            End If
                            'MsgBox True
                            j = j + 1
                        Loop
                    fin = j - 1
    
    'On copie les lignes qui nous intéressent
                    Range(Cells(4, 1), Cells(fin, 15)).Select
                    Selection.Copy
                    ThisWorkbook.Activate
                    Worksheets("INPUT").Activate
                    Range(Cells(ligne, 1), Cells(fin, 14)).Select
                    ActiveSheet.Paste
                        ' On ferme la fiche d'enchainement pour passer à la suivante
                    ClipBoard_Clear
                    Workbooks(Ench).Close savechanges:=False
                    ligne = fin - 1 'Pour éviter d'écraser les lignes collées par les suivantes
                Next
            End With
            h = h + 1
    Loop
    
'On supprime les mises en forme et les colonnes inutiles
                ThisWorkbook.Sheets("INPUT").Cells.Select
                    Selection.ClearFormats
                    With Selection.Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                        :=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = ""
                        .InputMessage = ""
                        .ErrorMessage = ""
                        .ShowInput = True
                        .ShowError = True
                    End With
                    
                    Range("U1").Activate
                    Range("C:C,F:G,K:N").Select
                    Selection.Delete shift:=xlToLeft
                    
                    ' Renommage des colonnes
                    Range("A1").Value = "Pas"
                    Range("B1").Value = "Action"
                    Range("C1").Value = "Domaine"
                    Range("D1").Value = "M.A"
                    Range("E1").Value = "Fiche"
                    Range("F1").Value = "Titre"
                    Range("G1").Value = "N° de cas"
                    Range("H1").Value = "Enchainement"
                    
                    With Range("A1:F1")
                        .Interior.ColorIndex = 1
                        .Font.ColorIndex = 2
                        .Font.Bold = True
                    End With
                    
                    Cells.Select
                    Cells.EntireColumn.AutoFit
End Sub

Auriez-vous une idée pour résoudre ce problème ? 😉

 

[skoobi]

Re : Conversion Variant to String : l'indice n'appartient pas à la sélection

Bonjour,

J'utilise la fonction filesearch, et je place le nom de chaque fichier dans un variant.

Pourquoi ne déclares-tu pas la variable comme String?

Dim NomFic as String

Bonne soirée.