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

Eawyne

XLDnaute Nouveau
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.

VB:
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 !
:)
 
Solution
Bonjour,
j'avais mal interprété la demande.
Si on doit chercher la valeur dans feuil2 :
VB:
'    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 -----------------------------------------------------------------------------------------------------

fanch55

XLDnaute Barbatruc
Bonjour,
Le code ci-dessous devrait pouvoir le faire :
renseignez {ligne} et {colonne]
VB:
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

XLDnaute Nouveau
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.
 

Eawyne

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

Run-time error '424':
Object required

Voici la ligne surlignée en Debug :
Code:
    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
 

Pièces jointes

  • Test.xlsm
    20.3 KB · Affichages: 4
Dernière édition:

fanch55

XLDnaute Barbatruc
Bonjour,
j'avais mal interprété la demande.
Si on doit chercher la valeur dans feuil2 :
VB:
'    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

XLDnaute Nouveau
Wow o_O 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

XLDnaute Barbatruc
Vlookup ==> RechercheV

Iferror ==> SiErreur
 

Discussions similaires

Statistiques des forums

Discussions
311 707
Messages
2 081 746
Membres
101 812
dernier inscrit
trufu