VBA : problème avec la méthode find

[jbballeyguier]

Bonjour,

je suis en train de travailler sur une macro qui réalise une recherche de fichiers, ouvre les fichiers trouvés, et fait un saveas de ces fichiers sous un autre nom et un autre répertoire.

Pour savoir sous quel nom le fichier doit être enregistré, j'ai une table de correspondance, ancien nouveau nom. Je décide donc de faire un find du nom du fichier ouvert sur la colonne qui contient l'ensemble des noms, pour voir si je le trouve, et si oui je regarde la cellule d'à coté pour récupérer le nouveau nom...

J'arrive à faire la recherche, j'arrive à ouvrir les fichiers... par contre le fin dans la colonne plante (la méthode activate de la classe range a échoué), et je n'arrive pas à trouver l'erreur :

Sub changenoms()
    ' Récupérer le nom de l'enchainement
    Dim enchainement As Range
    Dim nomench As String
    Dim ScanFic As Office.FileSearch
    Dim j As String
    Dim Chemin As String
    
j = 1
Set ScanFic = Application.FileSearch
Chemin = (ThisWorkbook.Path & "\" & "Enchainements")

    With ScanFic
                .NewSearch
                .LookIn = Chemin
                .SearchSubFolders = True
                .FileType = msoFileTypeExcelWorkbooks
                .Execute
                
                For Each NomFic In .FoundFiles
                    Workbooks.Open Filename:=NomFic, UpdateLinks:=False
                    Ench = CStr(NomFic)
                    Ench = Mid(Ench, InStrRev(NomFic, "\") + 1)

nomench = Workbooks(Ench).Sheets("CR détaillé").Range("C1").Value
ThisWorkbook.Sheets("Nomenclature").Range("C:C").Find(what:=nomench).Activate

                            If enchainement Is Nothing Then
                                MsgBox BOUM!
                            Else
                                nouveaunom = enchainement.Offset(0, -1)
                                
                                Workbooks(Ench).SaveAs nouveaunom & ".xls"
                                ActiveWorkbook.Close
                                
                            'lig = enchainement.Row
                            'col = enchainement.Column
                            End If
    
                    ThisWorkbook.Activate
                    
                Next
                    
    End With
    
End Sub

Quelqu'un aurait une idée ?

Merci d'avance

jb

 

[tototiti2008]

Re : VBA : problème avec la méthode find

bonjour jb,

tu demandes d'activer une cellule trouvée, même quand il ne la trouve pas, ce qui pose un problème.

Je te propose de remplacer :

ThisWorkbook.Sheets("Nomenclature").Range("C:C").Find(what:=nomench).Activate

par

Set enchainement = ThisWorkbook.Sheets("Nomenclature").Range("C:C").Find(what:=nomench)

il semble que tu avais déjà prévu cette variable pour gérer le cas...

 

[jbballeyguier]

Re : VBA : problème avec la méthode find

Merci tototiti2008

En fait, j'aimerai également récupérer l'adresse de la cellule trouvée, afin de pouvoir sélectionner la cellule située à gauche.

Actuellement je n'arrive à récupérer que la valeur... est-ce que c'est possible ?

 

[kjin]

Re : VBA : problème avec la méthode find

bonjour,
1 Si tu veux la sélectionner il suffit d'utiliser Select, mais est-ce bien utile
2 Si tu veux connaitre l'adresse, utilise Address
Si Tototiti, que je salue, était dans le vrai,

Set enchainement = ThisWorkbook.Sheets("Nomenclature").Range("C:C").Find(what:=nomench)
'If Not enchainement Is Nothing Then adresse_que_tu_cherche = enchainement.Offset(0, -1).Select    '===1===
If Not enchainement Is Nothing Then adresse_que_tu_cherche = enchainement.Offset(0, -1).Address     '===2===

Sinon, comprends pas la question
A+
kjin

 

[jbballeyguier]

Re : VBA : problème avec la méthode find

J'ai modifié ma macro et j'avance un peu :

[COLOR="Yellow"]Workbooks(Ench).Sheets("CR détaillé").Range("C1").Select[/COLOR]
nomench = ActiveCell.Value
Set enchainement = ThisWorkbook.Sheets("Nomenclature").Range("C:C").Find(what:=nomench)
'adresse = enchainement.Address

                            If enchainement Is Nothing Then
                                MsgBox "Bla"
                            End If
                            If Not enchainement Is Nothing Then
                                ThisWorkbook.Sheets("Nomenclature").Activate
                                adresse = enchainement.Offset(0, -2).Address
                                Range(adresse).Select
                                nouveaunom = ActiveCell.Value
                                Workbooks(Ench).Activate
                                ActiveWorkbook.SaveAs nouveaunom & ".xls"
                                ActiveWorkbook.Close

Cependant l'exécution s'arrête au moment de la sélection de la cellule C1 (voir en jaune).
Je ne comprend pas vraiment...

 

[kjin]

Re : VBA : problème avec la méthode find

Re,

Sub ChangeNoms()
Dim ScanFic As Office.FileSearch
Dim Chemin As String, Fichier As Variant
Dim Trouve As Range, AncienNom As String, NouveauNom As String
Application.ScreenUpdating = False
  
Set ScanFic = Application.FileSearch
Chemin = ThisWorkbook.Path & "\Enchainements"
With ScanFic
    .NewSearch
    .LookIn = Chemin
    .SearchSubFolders = True
    .FileType = msoFileTypeExcelWorkbooks
    .Execute
    For Each Fichier In .FoundFiles
        Workbooks.Open Filename:=Fichier, UpdateLinks:=False
        AncienNom = Sheets("CR détaillé").Range("C1").Value
        Set Trouve = ThisWorkbook.Sheets("Nomenclature").Range("C:C").Find(AncienNom)
        If Not Trouve Is Nothing Then
            NouveauNom = Trouve.Offset(0, -2)
            With ActiveWorkbook
            Application.DisplayAlerts = False
                .SaveAs Chemin & "\" & NouveauNom 'est cela ou dans un autre répertoire ?
                .Close
            Application.DisplayAlerts = True
            End With
        End If
    Next
End With
Application.ScreenUpdating = True
    
End Sub

A+
kjin