XL 2013 [VBA] Check contenu d'une cellule dans une autre feuille avec un retour via MsgBox

[Eawyne]

Bonjour !

voici un code que je fais tourner sur un fichier que nous utilisons au travail ; ce qu'il fait est d'aller checker le contenu d'un dossier dès qu'on entre une valeur dans une cellule d'une colonne entière : s'il y a correspondance, une MsgBox nous propose d'ouvrir le fichier idoine.

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim searchFolder As String, fileName As String
 Static PowerPointApp As Object

 searchFolder = "C:\Users\crolles300 oper\STMicroelectronics\C300 Lithography Module - Derogations STARLight"

 If Right(searchFolder, 1) <> "\" Then searchFolder = searchFolder & "\"

 If Target.Column = 2 Then
 If Target.CountLarge > 1 Then Exit Sub
 If Target.Value = "" Then Exit Sub

 fileName = Dir(searchFolder & "*" & Target.Value & "*.ppt*")
 If fileName <> vbNullString Then
 If MsgBox(fileName & " existe. Voulez-vous l'ouvrir ?", vbYesNo + vbQuestion, "Fiche de dérogation") = vbYes Then
 If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject("PowerPoint.Application")
 PowerPointApp.Presentations.Open searchFolder & fileName
 End If
 End If
 End If

 End Sub

Cela a demandé pas mal de travail, d'erreurs, et d'aide : mes connaissances en code/VBA sont fortement limitées. Mais là, mes maigres "skills" ne me suffisent plus ^^' J'aurais besoin de faire un second check à partir de la même valeur rentrée dans la cellule :

=> check le contenu de la cellule dans la Feuille 1 vers une colonne de la Feuille 2
=> s'il y a une correspondance, une MsgBox devrait afficher le contenu de la cellule +1 (offset) de la Feuille 2

Je suppose que je dois jouer avec la variable Target.Value & pour obtenir le bon message dans la Box, mais je n'en suis pas sûr. Idéalement, chaque macro devrait se lancer l'une après l'autre...

Bien des questions, plein de flou =/ J'ai googlé/duckducké un peu partout, mais je ne trouve pas de code qui puisse m'aider directement ; et mes limites ne me permettent pas de "merger" ces bouts de codes avec ce que j'ai déjà.

Je vous remercie d'avance pour toute aide que vous pourriez m'apporter !

 

[fanch55]

Bonjour,
Le code ci-dessous devrait pouvoir le faire :
renseignez {ligne} et {colonne]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim searchFolder As String, fileName As String
Static PowerPointApp As Object

If Target.Column = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
   ' Partie 1 ---------------------------------------------------------------------------------------------------------
    searchFolder = "C:\Users\crolles300 oper\STMicroelectronics\C300 Lithography Module - Derogations STARLight"
    If Right(searchFolder, 1) <> "\" Then searchFolder = searchFolder & "\"
    fileName = Dir(searchFolder & "*" & Target.Value & "*.ppt*")
    If fileName <> vbNullString Then
       If MsgBox(fileName & " existe. Voulez-vous l'ouvrir ?", vbYesNo + vbQuestion, "Fiche de dérogation") = vbYes Then
           If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject("PowerPoint.Application")
           PowerPointApp.Presentations.Open searchFolder & fileName
       End If
    End If
   ' Partie 2 ---------------------------------------------------------------------------------------------------------
    Dim Refcell As Range
    Set Refcell = WorkSheets("Feuil2").cells({Ligne},{colonne}).value
    If Target.Value = Refcell.Value Then
       MsgBox "le contenu=" & Refcell.Offset(, 1).Value
    End If
        
End If

End Sub

 

[Eawyne]

Merci pour la réponse !

En revanche, si j'arrive bien à rentrer la bonne valeur pour la Feuille, j'ai du mal à savoir quoi mettre pour les cells. Si je veux qu'il checke la colonne A uniquement, je pensais qu'il fallait mettre ("A, A") ? Quoi qu'il en soit, quoi que je mette, j'ai droit à :

Run-time error "5":
Invalid procedure call or argument

Remplacer par columns (1) n'aide pas non plus.

 

[fanch55]

Cells(1,1) --> ligne 1, colonne 1
Cells(1,"A") --> ligne 1,colonne A
range("A1") --> ligne 1,colonne A

 

[Eawyne]

J'ai testé chaque variable pour voir ; à chaque fois j'ai :

Run-time error '424':
Object required

Voici la ligne surlignée en Debug :

    Set Refcell = Worksheets("Feuil2").Cells(1, 1).Value

J'ai recréé une feuille avec le même nom que dans l'exemple, histoire de.

EDIT : ci-joint un fichier avec le code

 

[fanch55]

Arrrrgh, mal codé, c'est :

Set Refcell = WorkSheets("Feuil2").cells({Ligne},{colonne}).value​

Toutes mes excuses, mal expurgé le code ....

 

[Eawyne]

Yay, ça marche !!

Mais, je n'aime pas être chiant... ça ne marche que sur la première ligne J'ai essayé des dizaines de combinaisons. Je joins un fichier Test2 pour voir.

 

[fanch55]

Bonjour,
j'avais mal interprété la demande.
Si on doit chercher la valeur dans feuil2 :

'    Partie 2 ---------------------------------------------------------------------------------------------------------
    With Application
        Msg = .IfError(.VLookup(Target.Text, Worksheets("Sheet2").Columns("A:B"), 2, 0), "")
        If Msg <> "" Then MsgBox Target.Value & vbLf & vbLf & Msg, vbInformation
    End With
'    Fin Partie 2 -----------------------------------------------------------------------------------------------------

 

[Eawyne]

Wow je suis navré d'avoir fait perdre du temps en m'expliquant mal

En attendant, ça marche super bien ! Et d'un certain côté, avoir les deux solutions est une bonne idée, même si la seconde couvre tout...

Serait-ce trop demander que d'expliquer ce que cette nouvelle fonction fait exactement ?

Mais sinon, un grand merci !

 

[fanch55]

Vlookup ==> RechercheV

Fonction RECHERCHEV - Support Microsoft

Découvrez comment utiliser la fonction RECHERCHEV dans Excel pour rechercher des données dans un tableau ou une plage par ligne. Notre guide pas à pas rend vlookup dans Excel facile et efficace.

support.microsoft.com

Iferror ==> SiErreur

SIERREUR - Support Microsoft

Comment utiliser la fonction IFERROR dans Excel pour intercepter et gérer les erreurs dans une formule.

support.microsoft.com

 

[Eawyne]

Encore merci ; ça fait pas mal de sujets à potasser, mais au moins, j'en ai couvert un peu avec tout ça. J'espère ne plus avoir à demander du code désormais, mais juste des corrections