Double list + lancement de macros

Résolu
PandaZwan -  
PandaZwan Messages postés 4 Statut Membre -
Bonjour à tous,

Je ne suis qu'un embryon dans le domaine des macros Excel et du coup je picore des idée a gauche et a droite mais je vous avoue que j'ai du mal a les appliquée correctement a ma feuille ....

D'abord j'explique ce que je recherche,

J'ai une liste en Colone A et en Colone C, j'aimerais que quand un des élément de ma liste en colon C ce retrouve dans la Colone A la macro suivante sois jouée (Macros prise sur un autres forum et non crée par moi même)

""
Sub Douane()

Dim Sp As Object

On Error Resume Next
Set Sp = CreateObject("Sapi.SpVoice")
If Sp Is Nothing Then Exit Sub
Sp.Speak " Customs Control Detected"
End Sub
""

Pour expliquer plus en pronfondeur, je recois régulierement des conteneurs remplis de carton et j'aimerais que l'ors du scan des cartons (Colone A) la Colone C verifie si un de ces numéros correspond et a ce moment la elle déclenche la macros plus haut. Sachant que j'ai plusieurs numéros dans la Colone C et que la macros dois s'activer a chaques fois qu'un des numéros est repérer en colone A.

Je ne sais pas si je suis asser clair mais réellement j'en deviens fou :o

Configuration: Windows / Chrome 87.0.4280.88

1 réponse

  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    Voici un code à placer dans le module de la feuille concernée :
    Clic droit sur l'onglet de la feuille / Visualiser le code, copier-coller :
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Column = 1 Then                           'SI cellule modifiée est en colonne A
            If Target.Cells.Count = 1 Then                  'SI une seule cellule modifiée
                If Trouve(Target.Value) Then Douane         'SI trouve alors lance la Sub "Douane"
            End If
        End If
    End Sub
    Private Function Trouve(What As String) As Boolean
    Dim Rng As Range
        Set Rng = Me.Columns(3).Cells.Find(What)            'Cherche en colonne C
        Trouve = Not Rng Is Nothing
    End Function
    Private Sub Douane()
    Dim Sp As Object
        On Error Resume Next
        Set Sp = CreateObject("Sapi.SpVoice")
        If Sp Is Nothing Then Exit Sub
        Sp.Speak " Customs Control Detected"
    End Sub
    


    PS : Un MsgBox serait plus rapide et moins "coûteux". Quid des ordis sans HP? Quid si le son est coupé? etc...
    Pour un msgbox, ce code suffit :
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Column = 1 Then                           'SI cellule modifiée est en colonne A
            If Target.Cells.Count = 1 Then                  'SI une seule cellule modifiée
                Dim R As Range
                Set R = Trouve(Target.Value)
                If Not R Is Nothing Then
                    MsgBox "Référence trouvée en colonne C, cellule : C" & R.Row
                End If
            End If
        End If
    End Sub
    Private Function Trouve(What As String) As Range
        Set Trouve = Me.Columns(3).Cells.Find(What)            'Cherche en colonne C
    End Function


    2
    1. PandaZwan Messages postés 4 Statut Membre
       
      Bonjour Pijaku,

      C'est EXACTEMENT ce que je cherchais ! Coupler a une mise en forme conditionnelle c'est juste MA-GNI-FI-QUE.

      Pour infos le messagebox n'est pas pratique dans mon cas car je ne suis pas devant l'écran et je scan les boites a la chaine du coup je suis obliger d'avoir le signal sonore qui m'avertis que le carton scanner doit-être mis a l'écart.

      Je te remercie énormément encore 1x !
      0
      1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773 > PandaZwan Messages postés 4 Statut Membre
         
        Si c'est juste pour être averti, utilise la fonction Beep de la bibliothèque kernel32.
        Comme ceci :
        Option Explicit
        Private Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
        
        Private Sub Worksheet_Change(ByVal Target As Range)
            If Target.Column = 1 Then                           'SI cellule modifiée est en colonne A
                If Target.Cells.Count = 1 Then                  'SI une seule cellule modifiée
                    If Trouve(Target.Value) Then Bip 1200, 1000  'SI trouve alors lance la Sub "Bip"
                End If
            End If
        End Sub
        Private Function Trouve(What As String) As Boolean
        Dim Rng As Range
            Set Rng = Me.Columns(3).Cells.Find(What)            'Cherche en colonne C
            Trouve = Not Rng Is Nothing
        End Function
        Private Sub Bip(Frequence As Long, duree As Long)
            Beep Frequence, duree
        End Sub


        Tu peux changer la fréquence et la durée...
        0
      2. PandaZwan Messages postés 4 Statut Membre > pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention  
         
        Bonsoir Pijaku,

        C'est tout aussi intéressant, mais je viens de parler avec mon collègue et je t'avoue que les 2 pourraient nous êtres utiles.

        Je dois juste m'arranger pour changer de version d'Excel car sur notre Scan nous utilisons Office 365 Free, du coup il ne prend pas en charge les Macros ce qui nous embêtent légèrement :)

        Et ce Scan ne fonctionne pas en Plug and Play du coup impossible de passer par un Ordinateur portable ou autres.

        2 Solutions reste a ma portée, changer de Scan et utiliser un de mes ordinateur portable ou prendre une version payante d'Office, le moins onéreux serais surement changer de Scan.
        0