Besoin d'aide pour un "recherche-coller"

R

rainbow69006

XLDnaute Occasionnel
Bonjour

Je souhaiterais creer un genre de fonction recherche, qui recherche dans mes pages un mot speifie et me copie une partie de la colonne dans une feuille de resultat.

Comme un exemple vaut mieu qu'un long discours je vous joint un fichier avec plus d'expliquations

Merci:)
 

Pièces jointes

  • essai.xls
    36 KB · Affichages: 64
  • essai.xls
    36 KB · Affichages: 66
  • essai.xls
    36 KB · Affichages: 68
Trier par date Trier par votes
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Bonjour Skoobi

Le programe marche et j'en suis maintenant a l'insertion de ton programe photo.
Celui ci marche mais en fait ce que j'aurais voulu c'est sa:


.LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value\dossier1
Case 1: Range("B25").Select
(si il y a des photos dans ce raccourci sa les met en B25)

.LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value\dossier2
Case 2: Range("E25").Select
(si il y a des photos dans ce raccourci sa les met en E25)

.LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value\dossier3
Case 3: Range("B37").Select
(si il y a des photos dans ce raccourci sa les met en B37)

.LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value\dossier4
Case 4: Range("E37").Select
(si il y a des photos dans ce raccourci sa les met en E37)

.Filename = "*.bmp" (je voudrais aussi rajouter "jpg")

Apres est ce que l'on peu dire au programe quil ne prenne pas toutes les phots mais que la premiere par ordre alphabetique?
et est ce que l'on peu dire qu'il redimensionne la photo en lui diant pas plus haut et pas plus large que 3cm par exemple?


Je sais sa fais beaucoup de questions

Merci
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re bonjour,

.Filename = "*.bmp" (je voudrais aussi rajouter "jpg")
Cliquez pour agrandir...
Si dans le dossier il n'y a que des photos dans ce cas tu peux mettre ceci:
Code: 
        .Filename = "*"
sinon je ne sais pas comment ajouter 2 extensions.

et est ce que l'on peu dire qu'il redimensionne la photo en lui diant pas plus haut et pas plus large que 3cm par exemple?
Cliquez pour agrandir...
Surement, à creuser.....

voici la partie "image" modifié:

Code: 
For num_dos = 1 To 4
    With Application.FileSearch
'        .SearchSubFolders = True
        .LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox2.Value & "\dossier" & num_dos
        .Filename = "*.bmp"
        .Execute
        If .FoundFiles.Count > 0 Then
    '        For num = 1 To .FoundFiles.Count
                Select Case num_dos
                Case 1: Range("B25").Select
                Case 2: Range("E25").Select
                Case 3: Range("B37").Select
                Case 4: Range("E37").Select
                End Select
[B] 'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:[/B]
                ActiveSheet.Pictures.Insert (.FoundFiles(1))
    '        Next
        End If
    End With
Next
Edit: j'ai mis ce qui n'est plus valable en commentaire au lieu de le supprimer.
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

pour la taille de la photo, insère ceci (en bleu)

Code: 
.....
......
ActiveSheet.Pictures.Insert (.FoundFiles(1))
[COLOR=Blue][B]ActiveSheet.Shapes(num_dos).Height = 90
........
........


[/B][/COLOR]
A adapter.
 
Vote positif 0 Vote négatif
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Bonsoir skoobi

On ce rapproche plus que 3 questions:

- Peut tu me dire comment faire si on a pas dossier1,2,3,4 mais par exemple: aile,cockpit,train,fenetre
- J'ai essayer ActiveSheet.Shapes(num_dos).Height = 90 le probleme c'est que sa augmente la taille du logo, des 2 combobox du haut de page et d'une des 3 photos .(LE LOGO ET LES COMBOBOX devant etre considerer comme Shapes)
- Comment va t'on faire pour supprimer ls photos quand on change de marque et de modele?

= Merci Merci Merci
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

J'ai essayer ActiveSheet.Shapes(num_dos).Height = 90 le probleme c'est que sa augmente la taille du logo, des 2 combobox du haut de page et d'une des 3 photos .(LE LOGO ET LES COMBOBOX devant etre considerer comme Shapes)
Cliquez pour agrandir...
Effectivement, j'avais oublié les 2 menus déroulant, ajoute "2" à num_dos:

ActiveSheet.Shapes(num_dos + 2).Height = 90
Comment va t'on faire pour supprimer ls photos quand on change de marque et de modele?
Cliquez pour agrandir...

Je m'y attendais :D.
Ajoutes ceci au débit du code du Combobox2:

Code: 
For i = 2 To ActiveSheet.Shapes.Count
   ActiveSheet.Shapes(i).Delete
Next

Peut tu me dire comment faire si on a pas dossier1,2,3,4 mais par exemple: aile,cockpit,train,fenetre
Cliquez pour agrandir...

Je suppose que les noms de ces dossiers sont variables, là ça ce complique sérieusement......
 
Vote positif 0 Vote négatif
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Merci je vais essayer sa

Non je te rassure les noms de fichiers ne sont pas variables
on a toujours:
- la marque ex: "airbus"
- dans le dossier marque on a des dossiers :la marque + le model ex: ''airbus A322''
- et dans le dossier Airbus A322 on a quatre dossiers : "portes","ailes","autres","fenetre".

En gros on a 4 cas:
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"cockpit"
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"ailes"
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"train"
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"fenetre"

Voili voilou je sais pas si c'est plus clair

Pour ce qui est du redimensionement des photos j'ai mis sa: ActiveSheet.Shapes(num_dos + 3).Height = 90 comme tu me l'avais dit et sa marche

pour ce qui est de la suppresion des photos la sa bug
J'ai ce message d'erreur
"THE INDEX INTO THE SPECIFIED COLLECTION IS OUT OF BOUNDS"

Quand je met sa :

For num_dos = 1 To 4
With Application.FileSearch
' .SearchSubFolders = True
.LookIn = "C:\Documents and Settings\pierre\Desktop\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\dossier" & num_dos
.Filename = "*"
.Execute
If .FoundFiles.Count > 0 Then
' For num = 1 To .FoundFiles.Count
Select Case num_dos
Case 1: Range("B25").Select
Case 2: Range("E25").Select
Case 3: Range("B37").Select
Case 4: Range("E37").Select
End Select
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
ActiveSheet.Pictures.Insert (.FoundFiles(1))
ActiveSheet.Shapes(num_dos + 3).Height = 90

' Next
End If
End With
Next

For i = 4 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Delete
Next



Merci
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

pour ce qui est de la suppresion des photos la sa bug
J'ai ce message d'erreur
"THE INDEX INTO THE SPECIFIED COLLECTION IS OUT OF BOUNDS"
Cliquez pour agrandir...

Je vois que tu a changé le "i" de départ.
Le "i" de départ ici 4 doit correspondre à la 1ere image (s'il y en a et oui!!!!), il faut inclure une condition vérifiant qu'il y a des photos (les 3 premiers "shapes" devant correspondre aux listes déroulantes?

If ActiveSheet.Shapes.Count > 3 Then
For i = 4 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Delete
Next
End If
 
Vote positif 0 Vote négatif
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Salut Skoobi

J'ai essayer ton nouveau code mais malheureusement sa ne marche pas.
Quand il n'y a pas de photo et que je selectione un modele pas de probleme
je met les photos pas de probleme
mais quand je rechange de model j'ai toujours le meme message d'erreur
(sa me supprime les 2 photos de gauches mais pas celle de droite) :rolleyes:

Peut etre est ce que c'est possible de demander de supprimer toutes les shapes sauf les 3 premieres ? Qu'en pense tu ?

PS:
J'ai eu l'idee de faire sa:
If ActiveSheet.Shapes.Count > 3 Then
ActiveSheet.Shapes(4).Delete
End If

If ActiveSheet.Shapes.Count > 3 Then
ActiveSheet.Shapes(5).Delete
End If
eh bien sa marche sa supprime les 2 photos de droite

par contre pour les photos de gauches (si je met 6 et 7 sa ne marche pas) je pense que les shapes on un autre numero mais lequel...

Merci
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re bonjour,

le code suivant analyse chaque "shape" et le détruit si c'est une image:

Code: 
For Each sh In ActiveSheet.Shapes
    If sh.Name Like "Picture*" Then sh.Delete
Next
Non je te rassure les noms de fichiers ne sont pas variables
on a toujours:
- la marque ex: "airbus"
- dans le dossier marque on a des dossiers :la marque + le model ex: ''airbus A322''
- et dans le dossier Airbus A322 on a quatre dossiers : "portes","ailes","autres","fenetre".

En gros on a 4 cas:
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"cockpit"
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"ailes"
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"train"
- "C:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\"fenetre"
Cliquez pour agrandir...
Dans ce cas, il faudra écrire le code 4 fois:
Code: 
With Application.FileSearch
    .LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox2.Value & [B]"\cockpit"[/B]
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        [B]Range("B25").Select[/B]
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
    End If
End With

With Application.FileSearch
    .LookIn = "c:\" & ComboBox1.Value & "\" & ComboBox2.Value & [B]"\ailes"[/B]
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        [B]Range("E25").Select[/B]
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
    End If
End With
etc....
 
Vote positif 0 Vote négatif
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Bonjour skoobi

Eh bien ecoute cela a l'air pour le moment (je n'ai tester qu'un exemple) de marcher parfaitement.
J'ai rajouter ton code pour reduire les photos.

Je me permet de te demander: pour le moment on limite la taille de l'image en hauteur a 90
Est ce possible de lui dire l'image ne doit pas etre superieur a 90 en hauteur et 120 en longueur?

Merci
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re bonjour,

Je me permet de te demander: pour le moment on limite la taille de l'image en hauteur a 90
Est ce possible de lui dire l'image ne doit pas etre superieur a 90 en hauteur et 120 en longueur?
Cliquez pour agrandir...
Et bien c'est ce que fait l'instruction ci-dessous pour la hauteur non?

ActiveSheet.Shapes(num_dos + 3).Height = 90

Je comprends pas ce que tu veux dire :confused:

pour la largeur, tu devrais trouvé je pense.....
 
Vote positif 0 Vote négatif
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

C'est bon j'y suis arrive!!:)

Est ce que tu comprend ce phenome?
Quand j'ouvre mon classeur je me retrouve sur la page "base" mais ce qui est entre F1 et AM595 est supprimer. (alors que dans mon code c'est sur la page : 'donnee')

Merci beaucoup..... Mon application de 250Mo et bientot fini ouf!!

Code: 
Private Sub Workbook_Open()
Sheets("base").Activate

With Sheets("Donnee")
Range("F1:AM595").ClearContents
    Range("BX1:DE595").Select
    Selection.Copy
    Range("F1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With
End Sub
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

Re,

quand tu écris With ........ End With, il ne faut pas oublié de mettre le point "." pour y faire référence sinon il prend en compte la feuille active ;):

With Sheets("Donnee")
.Range("F1:AM595").ClearContents
.Range("BX1:DE595").Copy
.Range("F1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With

Autre chose, évite les ".Select", inutile en VBA et ralentie la macro (le défaut de l'enregistreur de macro).
 
Vote positif 0 Vote négatif
R

rainbow69006

XLDnaute Occasionnel
Re : Besoin d'aide pour un "recherche-coller"

Ah ok

J'avais trouve une solution en rusant :)

en mettant ce code et mon code au dessus dans celui de la page "Donnee"

Code: 
Private Sub Workbook_Open()
Sheets("Sheet1").Activate
Sheets("DONNEE").Activate
Sheets("base").Activate

End Sub

Lol j'avoue c'est tres moche mais sa marche
---> Mais bon je vais quand meme mettre les points sa sera quand meme mieu ;)
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Besoin d'aide pour un "recherche-coller"

rainbow69006 à dit:
Ah ok

J'avais trouve une solution en rusant :)

en mettant ce code et mon code au dessus dans celui de la page "Donnee"

Code: 
Private Sub Workbook_Open()
Sheets("Sheet1").Activate
Sheets("DONNEE").Activate
Sheets("base").Activate

End Sub
Lol j'avoue c'est tres moche mais sa marche
---> Mais bon je vais quand meme mettre les points sa sera quand meme mieu ;)
Cliquez pour agrandir...

De plus tu ne verras pas les feuilles "défilées" pendant l'exécution sans raison.
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Besoin d'aide pour plusieurs petite chose technique sur un fichier excel
8 9 10
Réponses
136
Affichages
7 K
TooFatBoy
TooFatBoy
C
  • Résolu(e)
XL 2010 Recherche
Réponses
2
Affichages
229
CATPLUS
C
frasylest
  • Résolu(e)
Microsoft 365 Formulaire de recherche avec résultat dans autre formulaire
Réponses
2
Affichages
286
frasylest
frasylest
P
  • Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
345
phoceenjo
P
C
  • Question
XL pour MAC Lien Hypertexte
Réponses
2
Affichages
443
christophe43333333
C
B
  • Résolu(e)
Microsoft 365 Recherche dans tableaux suivant 4 critères
2
Réponses
15
Affichages
620
Blf57
B
G
  • Question
XL 2021 rassembler des données de plusieurs feuilles d'un classeur sur une nouvelle feuille du meme classeur selon un critère
Réponses
1
Affichages
219
Staple1600
Staple1600
S
  • Question
XL 2016 aditionner et soustraire des heures en fonction d'un critère
Réponses
2
Affichages
295
shushen
S
M
  • Question
Microsoft 365 Recopie ligne avec un code GOOGLE SHEET
Réponses
7
Affichages
239
Moreno076
M
B
  • Question
XL 2016 recherche dans une colonne depuis un autre onglet
Réponses
5
Affichages
203
boguinette
B

Membres actuellement en ligne

11 membres et 108 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 779
Messages
2 092 044
Membres
105 162
dernier inscrit
djikon