Double list + lancement de macros [Résolu]

Signaler
-
Messages postés
4
Date d'inscription
dimanche 6 décembre 2020
Statut
Membre
Dernière intervention
23 décembre 2020
 -
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
Afficher la suite

1 réponse

Réponse 1 / 1
Messages postés
12235
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
6 janvier 2021
 2 554
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


Cordialement,
Franck
Signaler
Messages postés
4
Date d'inscription
dimanche 6 décembre 2020
Statut
Membre
Dernière intervention
23 décembre 2020
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 !
Signaler
Messages postés
12235
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
6 janvier 2021
 2 554 >
Messages postés
4
Date d'inscription
dimanche 6 décembre 2020
Statut
Membre
Dernière intervention
23 décembre 2020
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...
Signaler
Messages postés
4
Date d'inscription
dimanche 6 décembre 2020
Statut
Membre
Dernière intervention
23 décembre 2020
 >
Messages postés
12235
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
6 janvier 2021
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.
Répondre Posez votre question