Est il possible de faire une recherche en vba utilisant des boucles et itérations ?

mahamalily

XLDnaute Nouveau
Bonjour à tous,

Je suis actuellement à la recherche de comment faire une recherche tout en utilisant des boucles telles que while, for, ... et l'itération if...

En fait, j'explique le contexte :

J'ai une feuille nommée par exemple Doc1.

Dans Doc1, j'ai plusieurs parties :

- une partie qui affiche TOUTES les informations (comme si c'était une base de données, ...)

- une partie ( à coté ) qui contient les mêmes noms de colonne que la 1ère partie mais qui contient un bouton nommé "Extraire". Cette partie permet de faire en sorte que quand on saisit une information quelconque et qu'on clique sur le bouton "Extraire", on recherche parmi les informations situées dans la 1ere partie dans la colonne concernée...
Et quand il trouve des résultats, il faut qu'il affiche les résultats dans : la 3eme partie expliquée ci-après

- une partie à coté de la 2eme partie qui affiche les résultats de l'extraction. ensuite, on peut cliquer sur un bouton "'imprimer" pour qu'il imprime les informations. Je pensais à faire par rapport à une sélection mais je ne suis pas sûre que ce soit très facile...

BREF, voici le truc. Je fais un rappel : je suis débutant en vba sous excel !!
Et pour j'ai déjà un code mais qui ne fonctionne pas vu que ca passe de excel 97 à 07...

Le voici :

Code:
Sub Filtrage()
  Application.ScreenUpdating = False
  Protection "FTBP", False
  Range(Cells(200, 29), Cells(3, 25)).Select
  Selection.Clear
  Protection "FTBP", False
  Application.Goto Reference:="BD"
  ' Filtre la base en fonction d'un critere
  Range(Cells(2, 1), Cells((Selection.Rows.Count + Selection.Row - 1), 12)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("M2:W3"), CopyToRange:=Range("Y2:AC1016"), Unique:=False
  Cells(2, 1).Select
  Extract = True
  Application.ScreenUpdating = True
  Impression
End Sub
' Module d'impression des etiquettes
Sub Impression()
  
  On Error Resume Next
  Dim Rep As Integer
  If Not Extract Then
    Rep = MsgBox("Pour imprimer le dernier resultat cliquer sur oui." & vbCrLf & "Cliquer sur non pour extraire de nouvelles données.", vbYesNo + vbQuestion, "Impression...")
    If Rep = vbNo Then
      Filtrage
      Exit Sub
    End If
  End If
  If Extract Or Rep = vbYes Then
   Application.ScreenUpdating = False
   Sheets("IMPRESSION").Visible = True
   Sheets("IMPRESSION").Select
   Range("A9:N43").Select
   With Selection.Font
    .Name = "Arial"
    .Size = 9
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    .Bold = True
  End With
  ActiveSheet.PageSetup.PrintArea = "$A$9:$N$43"
  With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(1.56)
        .RightMargin = Application.InchesToPoints(1.56)
        
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)

        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = -4
    .CenterHorizontally = True
    .CenterVertically = True
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
   End With
   'Application.ScreenUpdating = True
   ActiveWindow.SelectedSheets.PrintPreview
   '##### Impression Page 2
    Range("O9:AN22").Select
   With Selection.Font
    .Name = "Arial"
    .Size = 9
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    .Bold = True
  End With
  ActiveSheet.PageSetup.PrintArea = "$O$9:$AN$22"
  With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.78740157480315)
    .RightMargin = Application.InchesToPoints(0.78740157480315)
    .TopMargin = Application.InchesToPoints(0.984251968503937)
    .BottomMargin = Application.InchesToPoints(0.984251968503937)
    .HeaderMargin = Application.InchesToPoints(0.511811023622047)
    .FooterMargin = Application.InchesToPoints(0.511811023622047)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = -4
    .CenterHorizontally = True
    .CenterVertically = True
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
   End With
   Application.ScreenUpdating = True
   ActiveWindow.SelectedSheets.PrintPreview
   Sheets("IMPRESSION").Visible = False
  End If
  Workbooks("FTBP").Select
End Sub

Dans ce code , les boutons "Extraire" et "imprimer" sont rassemblés en un même point...

Merci de bien vouloir m'aider...
 

Pierrot93

XLDnaute Barbatruc
Re : Est il possible de faire une recherche en vba utilisant des boucles et itération

Bonjour,

commence peut être par enlever cette instruction, qui ne te permet pas de détecter tes erreurs...
Code:
On Error Resume Next

bon après midi
@+
 

Gorfael

XLDnaute Barbatruc
Re : Est il possible de faire une recherche en vba utilisant des boucles et itération

Salut mahamalily et le forum
BREF, voici le truc. Je fais un rappel : je suis débutant en vba sous excel !!
Et pour j'ai déjà un code mais qui ne fonctionne pas vu que ca passe de excel 97 à 07...
Je lis ça et je comprends que ta macro fonctionnait correctement sous V.97 et le passage à V.2007 fait qu'elle ne fonctionne plus...

Et je suis trop faible en VBA pour comprendre comment l'adapter, vu que pour moi, la macro filtrage ne devrait même pas pouvoir fonctionner, quelque soit la version.
A+
 

Discussions similaires

Statistiques des forums

Discussions
312 207
Messages
2 086 250
Membres
103 165
dernier inscrit
thithithi78