Faire la fonction goto sans l'utiliser

iguan

XLDnaute Nouveau
Bonjour,

Je voudrais faire une fonction goto sans l'utiliser. Je sais que c'est le meilleur moyen de créer un programme qui ne s'arrête jamais alors je ne veut pas l'utiliser.

Mon programme fait de la recherche de contenu dans les zones de textes, ensuite il va demander si on veut rechercher la suivante et en fonction de la reponse le programme s'arrête ou recommence:

VB:
'déclarations des variable

While ...               'boucle qui fera recommencer le programme
    If ... Then         'test qui affichera ou pas la inputbox 
                           'récupérer le numéro d'OF à rechercher par Inputbox
    End If
    
                           'Recherche le texte voulu dans toutes les zones de textes et dans chaque feuille du classeur

Select Case MsgBox("Chercher le numéro d'OF suivant ?", vbYesNo + vbQuestion, "Rechercher")
      Case vbYes
      ...
     Case vbNo
     Exit Sub
End Select
Wend

End Sub

Voila, il faudrait que je remplisse les "..." mais je ne sait pas trop comment procéder. A partir du 2eme passage la inputbox ne doit plus s'afficher.

Si quelqu'un à une petite idée.
Merci d'avance.
A+
 

iguan

XLDnaute Nouveau
Re : Faire la fonction goto sans l'utiliser

Bonjour Pierrot93,

En faite pour moi le plus simple serai de faire ceci:
VB:
'déclarations des variable

'boucle qui fera recommencer le programme
'test qui affichera ou pas la inputbox 
'récupérer le numéro d'OF à rechercher par Inputbox

etiquette :  
                           'Recherche le texte voulu dans toutes les zones de textes et dans chaque feuille du classeur

Select Case MsgBox("Chercher le numéro d'OF suivant ?", vbYesNo + vbQuestion, "Rechercher")
      Case vbYes
      goto etiquette
      Case vbNo
     Exit Sub
End Select

End Sub

Ce que j'ai peur c'est que mon programme ne s'arrête jamais.
Bon aprem a toi aussi
a+
 

mécano41

XLDnaute Accro
Re : Faire la fonction goto sans l'utiliser

Bonjour,

Ou bien comme cela :

Code:
Sub essai()
Do Until MsgBox("Chercher le numéro d'OF suivant ?", vbYesNo + vbQuestion, "Rechercher") = vbNo
    '.... ici opérations à faire ...
Loop
End Sub

Cordialement
 

iguan

XLDnaute Nouveau
Re : Faire la fonction goto sans l'utiliser

Ma seconde question concerne la recherche :

Une étape (recuit, revenu, etc...) correspond a une zone de texte, la largeur défini le temps et un numéro d'OF correspond a une pièce.

Voila se que le code doit faire:
-L'utilisateur rentre le numéro d'Of rechercher
-Le programme cherche dans tous le contenu de chaque zone de texte le numéro d'OF
-Une fois trouver le programme demande à l'utilisateur si il veut rechercher le suivant (un même numéro d'Of peut être utilisé pour plusieurs étapes)
-Si oui il DOIT continuer sa recherche a partir de ce point. Si non il centre l'écran sur la zone de texte puis s'arrete.

Le problème est le oui, le programme va recommencer sa recherche à partir du début. Ce que je voudrais c'est qu'il continue a la zone de texte (=étape) suivante.

Voici le code :
VB:
Private Sub CommandButton1_Click()
Dim laShape As Shape, celluleCentre As Range, centreT As Double, centreL As Double, i As Long
Dim nbColAffichees As Long, nbLigAffichees As Long, decalageCol As Long, decalageLig As Long
Dim numOf As String, laFeuille As Worksheet, trouve As Boolean, z As Integer


    'récupérer le numéro d'OF à rechercher
   numOf = InputBox("Numéro d'OF à rechercher :", "Rechercher")

    
etiquette:
    trouve = False
    'boucler sur chaque feuille du classeur
    For Each laFeuille In ThisWorkbook.Sheets
        'boucler sur toutes les formes de la feuille
        For Each laShape In laFeuille.Shapes
            If laShape.Name Like "Text Box *" Then
            If laShape.TextFrame.Characters.Text Like "*" & numOf & "*" Then trouve = True
            If trouve Then Exit For
            End If
        Next laShape
    If trouve Then Exit For
    Next laFeuille
    
    'si aucune forme contenant le numéro d'of n'a été trouvée, quitter la macro
    If laShape Is Nothing Then
                                MsgBox "Non trouvé"
                                Exit Sub
    End If
    
    'activer la feuille et sélectionner la forme
   laFeuille.Activate
    laShape.Select
   
    'centrer la forme à l'écran
   'calculer les "coordonnées" du centre de la forme
   centreT = laShape.Top + laShape.Height / 2
    centreL = laShape.Left + laShape.Width / 2
   
    'calculer la cellule correspondante aux "coordonnées"
   Set celluleCentre = Sheets(1).Range("A1")
       
    While celluleCentre.Offset(0, 1).Left < centreL
        Set celluleCentre = celluleCentre.Offset(0, 1)
    Wend
    While celluleCentre.Offset(1, 0).Top < centreT
        Set celluleCentre = celluleCentre.Offset(1, 0)
    Wend
   
    'vériffier le nombre de lignes et colonnes affichées
   nbColAffichees = ActiveWindow.VisibleRange.Columns.Count
    nbLigAffichees = ActiveWindow.VisibleRange.Rows.Count
   
    'calculer la cellule (colonne et ligne) à afficher en haut à droite
   decalageCol = IIf(celluleCentre.Column - CInt(nbColAffichees / 2) + 1 < 1, 1, celluleCentre.Column - CInt(nbColAffichees / 2) + 1)
    decalageLig = IIf(celluleCentre.Row - CInt(nbLigAffichees / 2) + 1 < 1, 1, celluleCentre.Row - CInt(nbLigAffichees / 2) + 1)
   
    'positionner la fenêtre (bugge depuis VBE, la macro doit être lancée depuis le excel)
   ActiveWindow.ScrollColumn = decalageCol
    ActiveWindow.ScrollRow = decalageLig

'MsgBox Oui + Non
Select Case MsgBox("Chercher le numéro d'OF suivant ?", vbYesNo + vbQuestion, "Rechercher")
Case vbYes
GoTo etiquette
'procédure si click sur Oui
Case vbNo
'procédure si click sur Non
 Exit Sub
End Select

End Sub

Merci d'avance
a+
 

Si...

XLDnaute Barbatruc
Re : Faire la fonction goto sans l'utiliser

Salut

ainSi... peut-être ,
Code:
Private Sub CommandButton1_Click()
  Dim laShape As Shape, celluleCentre As Range, centreT As Double, centreL As Double, i As Long
  Dim nbColAffichees As Long, nbLigAffichees As Long, decalageCol As Long, decalageLig As Long
  Dim numOf As String, laFeuille As Worksheet, trouve As Boolean, z As Integer

  Do
  'récupérer le numéro d'OF à rechercher
    numOf = InputBox("Numéro d'OF à rechercher :", "Rechercher")

    'boucler sur chaque feuille du classeur
    For Each laFeuille In ThisWorkbook.Sheets
    'boucler sur toutes les formes de la feuille
      For Each laShape In laFeuille.Shapes
        If laShape.Name Like "TextBox*" Then
          If laShape.TextFrame.Characters.Text Like "*" & numOf & "*" Then
            laFeuille.Activate
            laShape.Select

            'centrer la forme à l'écran
            'calculer les "coordonnées" du centre de la forme
            centreT = laShape.Top + laShape.Height / 2
            centreL = laShape.Left + laShape.Width / 2

            'calculer la cellule correspondante aux "coordonnées"
            Set celluleCentre = Sheets(1).Range("A1")

            While celluleCentre.Offset(0, 1).Left < centreL
              Set celluleCentre = celluleCentre.Offset(0, 1)
            Wend
            While celluleCentre.Offset(1, 0).Top < centreT
              Set celluleCentre = celluleCentre.Offset(1, 0)
            Wend

           'vériffier le nombre de lignes et colonnes affichées
            nbColAffichees = ActiveWindow.VisibleRange.Columns.Count
           nbLigAffichees = ActiveWindow.VisibleRange.Rows.Count

            'calculer la cellule (colonne et ligne) à afficher en haut à droite
            decalageCol = IIf(celluleCentre.Column - CInt(nbColAffichees / 2) + 1 < 1, 1, celluleCentre.Column - CInt(nbColAffichees / 2) + 1)
            decalageLig = IIf(celluleCentre.Row - CInt(nbLigAffichees / 2) + 1 < 1, 1, celluleCentre.Row - CInt(nbLigAffichees / 2) + 1)

           'positionner la fenêtre (bugge depuis VBE, la macro doit être lancée depuis le excel)
           ActiveWindow.ScrollColumn = decalageCol
           ActiveWindow.ScrollRow = decalageLig
           'MsgBox Oui + Non
           If MsgBox("Chercher le numéro d'OF suivant ?", vbYesNo + vbQuestion, "Rechercher") = vbNo Then Exit Do
           Exit For
         End If
       End If
      Next laShape
   Next laFeuille
  Loop
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 495
Messages
2 088 969
Membres
103 993
dernier inscrit
Essens