Fonction * (rechercher tout) dans VBA Excel

Macro
1

Bonjour, j’ai récupérer une macro VBA Excel mais je ne sais la modifier correctement.
Elle recherche le numéro de plan (Plan) puis la désignation (Désignation) mais vu que certains noms de PDF ne correspondent pas exactement pour la désignation dans la base de donnée des plans, la copie échoue.
Je voudrais remplacer Désignation par quelque chose qui soit l’équivalent de la recherche « * » de Windows.

Voici la macro actuelle :

ThisWorkbook.Sheets(« Feuil3 »).Cells(b, 1).Interior.Color = RGB(204, 255, 204)
LienRecherche = «  »
LienCopie = «  »
Plan = ThisWorkbook.Sheets(« feuil3 »).Cells(b, 1).Text
Désignation = ThisWorkbook.Sheets(« feuil3 »).Cells(b, 2).Text
LienRecherche = "C:\FIVE-SERVICES\BIBLIOTHEQUE STANDARDS\Copie_PDF_Standard" & Plan & " - " & Désignation & « .pdf »
LienCopie = ThisWorkbook.Sheets(« feuil3 »).Cells(1, 4).Text & "" & Plan & " - " & Désignation & « .pdf »
FileCopy LienRecherche, LienCopie

2

Bonjour,

Pas sûr de bien comprendre. Le but c’est de rechercher dans le dossier ou dans Excel?

1 « J'aime »
3

Le but est de rechercher dans le dossier suivant le nom trouvé dans le excel. Sauf que les 2 ne correspondent pas. Donc je voudrais qu’il copie même si il ne trouve pas le nom correct de la désignation.

4

Salut,
Utilise la balise « Code » pour poster les codes. Ce sera bien plus lisible ainsi.
Le code que tu nous montre créé un lien de recherche. Il n’effectue pas la recherche.

Tu dois avoir une fonction qui effectue la recherche. Montre nous comment elle est faite. :wink:

5

Est-ce qu’il y a au moins un terme qui correspond sinon je ne vois pas comment faire ?
Fonction instr pour ce cas.

6 
Public DerLigne As Long
Public DerPlan As Long
Public a As Long
Public b As Long
Public c As Long
Public LienRecherche As String
Public LienCopie As String
Public Plan As String
Public Désignation As String
Public TempsMacro As Double

Public Sub IdentifierPlans()

Application.ScreenUpdating = False
TempsMacro = Timer
DerPlan = ThisWorkbook.Sheets("Feuil3").Range("a65000").End(xlUp).Row

'With ThisWorkbook.Sheets("feuil3").Range("A1:B" & DerPlan)
With ThisWorkbook.Sheets("feuil3").Range(Cells(1, 1), Cells(DerPlan, 2))
    .ClearContents
    .Interior.TintAndShade = 0
    .Interior.Pattern = xlNone
    .Font.Color = RGB(0, 0, 0)
End With
 
DerLigne = ThisWorkbook.Sheets("feuil1").Range("c65000").End(xlUp).Row
b = 1
For a = 17 To DerLigne
    If ThisWorkbook.Sheets("feuil1").Cells(a, 1) = "x" Or ThisWorkbook.Sheets("feuil1").Cells(a, 1) = "X" Then
        If Left(ThisWorkbook.Sheets("feuil1").Cells(a, 3), 1) = "A" Then
        Else
            ThisWorkbook.Sheets("feuil3").Cells(b, 1) = LTrim(ThisWorkbook.Sheets("feuil1").Cells(a, 3))
            ThisWorkbook.Sheets("feuil3").Cells(b, 2) = LTrim(ThisWorkbook.Sheets("feuil1").Cells(a, 5))
            b = b + 1
        End If
    End If
Next a

ThisWorkbook.Sheets("feuil3").Range(Columns(1), Columns(2)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo

Application.ScreenUpdating = True

ThisWorkbook.Sheets("Feuil3").Cells(2, 4).Value = "Temps d'exe de la macro : " & Round(Timer - TempsMacro, 2) & " s"

End Sub

Public Sub CopierPlans()
TempsMacro = Timer
DerPlan = ThisWorkbook.Sheets("Feuil3").Range("a65000").End(xlUp).Row
c = 0
On Error GoTo Erreur
'On Error Resume Next


For b = 1 To DerPlan
Suite:
        ThisWorkbook.Sheets("Feuil3").Cells(b, 1).Interior.Color = RGB(204, 255, 204)
        LienRecherche = ""
        LienCopie = ""
        Plan = ThisWorkbook.Sheets("feuil3").Cells(b, 1).Text
        Désignation = ThisWorkbook.Sheets("feuil3").Cells(b, 2).Text
        LienRecherche = "C:\FIVE-SERVICES\BIBLIOTHEQUE STANDARDS\Copie_PDF_Standard\" & Plan & " - " & Désignation & ".pdf"
        LienCopie = ThisWorkbook.Sheets("feuil3").Cells(1, 4).Text & "\" & Plan & " - " & Désignation & ".pdf"
        FileCopy LienRecherche, LienCopie
Next b

ThisWorkbook.Sheets("Feuil3").Cells(2, 4).Value = "Temps d'exe de la macro : " & Round(Timer - TempsMacro, 2) & " s"

If c = 0 Then
    MsgBox "Nickel, tous les PDF ont été copiés", vbOKOnly, "Fichiers copiés"
Else
    If c = 1 Then
        MsgBox "Certains PDF ont été copiés mais il y a " & c & " erreur", vbExclamation + vbOKOnly, "Fichiers copiés partiellement"
    Else
        MsgBox "Certains PDF ont été copiés mais il y a " & c & " erreurs", vbExclamation + vbOKOnly, "Fichiers copiés partiellement"
    End If
End If
Exit Sub
Erreur:
ThisWorkbook.Sheets("Feuil3").Cells(b, 1).Interior.Color = RGB(255, 80, 80)
c = c + 1
Resume Next

End Sub

Voici la macro entière.

7

Ton code fait référence à une fonction FileCopy : FileCopy LienRecherche, LienCopie

Elle est peut être dans un autre module.

8

Oui le début du fichier est correct. Exemple : SDA-CAD-002-A - Bossage à souder.pdf alors que la recherche est faite avec « SDA-CAD-002-A - Bossage à souder Inox » donc il ne trouve pas. Le début « SDA-CAD-002-A » est bon. Mais je voudrais qu’il évite « Bossage à souder Inox » mais qu’il copie quand même le fichier qu’il trouve avec « SDA-CAD-002-A ».
Comme quand on fait « rechercher » dans Windows avec « SDA-CAD-002-A*.pdf » en fait.

9

Heu FileCopy c’est une fonction à elle seule non? Elle copie les fichiers selon « LienRecherche » en "LienCopie selon les 2 lignes au dessus?

10

Effectivement, je ne connais pas bien les fonctions VBA.
Donc, il n’y a aucune fonction de recherche. Ton code créé un chemin avec les éléments du tableau.
Tu dois donc créer cette recherche et remplacer le chemin par les résurltats de ta recherche.
Pour t’aider, regarde la fonction GetFiles.