Microsoft 365 lancer un code de la feuille active et afficher le MsgBox sur la feuille active sans activer l'autre feuille

Usine à gaz

XLDnaute Barbatruc
Bonsoir à toutes et à tous,

Je cherche à faire ce qui suit :
Contexte
Je suis sur la feuille "Lancement_code_ici" (feuille active d'où je clique sur mon bouton "MsgBox Rappels du jour"
- sans activer la feuille "RdV_transfert", le code s'éxécute et le MsgBox s'affiche en restant sur la feuille active et le code se termine sans activer la feuille "RdV_transfert"

Je n'ai pas réussi à l'instant à le faire.
Pourriez-vous m'aider ?
Je joins je fichier test et je continue à chercher.

Un grand merci par avance,
lionel :)
 

Pièces jointes

  • forum_test.xlsm
    47.3 KB · Affichages: 8
Solution
Salut à tous,
Code :
VB:
Sub cherche()
Dim Col As Range, Msg As String
Dim T   As String: T = String(20, "-")
Const Dlm = ":   "
    
    Set Col = Worksheets("Rdv_transfert").Columns("h:h").Find( _
              "à confirmer", , xlValues, xlPart, xlByRows, xlNext)
    If Not Col Is Nothing Then
        Set Col = Col.Parent.Rows(Col.Row).Columns
        Msg = "Réseau" & vbTab & vbTab & Dlm & Col("E") & vbLf & _
              "Agent " & vbTab & vbTab & Dlm & Col("F") & vbLf & _
              "Date RdV" & vbTab & Dlm & Col("B") & vbLf & _
              "Date Appel" & vbTab & Dlm & Col("C") & vbLf & _
              "Intervalle" & vbTab & vbTab & Dlm & Abs(DateDiff("d", Col("B"), Col("C"))) & vbLf & vbLf & _
              "ENVOI ? = OUI...

laurent950

XLDnaute Barbatruc
Bonsoir @Usine à gaz

VB:
With Sheets("RdV_transfert").Columns("h:h")
    On Error Resume Next
        .Find(What:="à confirmer", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
       .Offset(0, 1) = "=VALUE(LEFT(REPLACE(REPLACE(RC[-7],3,1,""/""),6,1,""/""),10))-RC[-6]"
       .Offset(0, 2) = "Réseau               :    " & .Offset(0, -3) & Chr(10) & "Agent                 :   " _
    & " " & .Offset(0, -2) & Chr(10) & "Date RdV           :   " & " " & .Offset(0, -6) & Chr(10) _
    & "Date Appel        :   " & " " & .Offset(0, -5) & Chr(10) & "Nbr jours entre :   " & " " & .Offset(0, 1) _
    & Chr(10) & Chr(10) & "ENVOI ? = OUI        ou      NON"
    
    
    'MsgBox ActiveCell.Offset(0, 2)
    If MsgBox(prompt:=.Offset(0, 2), Buttons:=vbQuestion + vbYesNo) <> vbNo Then
        .Offset(0, 3) = "Envoi"
    Else
        .Offset(0, 3) = "Ne pas envoyer"
    End If
        .Offset(0, 1) = ""
        .Offset(0, 2) = ""
End With
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Bonjour Paurent95 , Bonjour Phil69970,
Merci pour vos retours :)

Je replace le résultat attendu :
Au clic sur le bouton en feuille active le MsgBox doit :
- afficher les informations de la feuille "RdV_transfert" > 1ère ligne qui contient en col H la mention "à confirmer",
- exécuter la fin du code au clic sur OUI ou NON,
Tout en en restant sur la feuille active.
Résultat attendu :
MsgBox
1642839067329.png

feuille "RdV_transfert"

La ligne 2 étant la 1ère ligne qui contient 1ère ligne qui contient en col H la mention "à confirmer" >en K2 selon clic OUI ou NON ("Envoi" ou "Ne pas envoyer")

@laurent
Le MsgBox ne s'affiche pas rempli et toutes les cellules en col K sont traitées.
Seule la feuille "RdV_transfert" > 1ère ligne qui contient en col H la mention "à confirmer" doit être traitée :)

@Phil69970
L'affichage du MsgBox se fait bien sur la feuille active mais il n'y a rien dedans.

Je remets en pièce jointe le Fichier de Phil avec vos 2 codes.
Merci à vous 2 pour m'avoir répondu,
Amicalement,
Lionel :)
 

Pièces jointes

  • Forum_test V1.xlsm
    57.7 KB · Affichages: 1

fanch55

XLDnaute Barbatruc
Salut à tous,
Code :
VB:
Sub cherche()
Dim Col As Range, Msg As String
Dim T   As String: T = String(20, "-")
Const Dlm = ":   "
    
    Set Col = Worksheets("Rdv_transfert").Columns("h:h").Find( _
              "à confirmer", , xlValues, xlPart, xlByRows, xlNext)
    If Not Col Is Nothing Then
        Set Col = Col.Parent.Rows(Col.Row).Columns
        Msg = "Réseau" & vbTab & vbTab & Dlm & Col("E") & vbLf & _
              "Agent " & vbTab & vbTab & Dlm & Col("F") & vbLf & _
              "Date RdV" & vbTab & Dlm & Col("B") & vbLf & _
              "Date Appel" & vbTab & Dlm & Col("C") & vbLf & _
              "Intervalle" & vbTab & vbTab & Dlm & Abs(DateDiff("d", Col("B"), Col("C"))) & vbLf & vbLf & _
              "ENVOI ? = OUI        ou      NON"
      
        If MsgBox(Msg, vbQuestion + vbYesNo, T & "> " & Col("A") & " <" & T) <> vbNo _
        Then Col("K") = "Envoi" Else Col("K") = "Ne pas envoyer"
        
    End If
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Re à tous,

Je reviens sur le fil pour un p'tit souci de présentation :
J'ai ajouté une ligne d'information,
Le code affiche :
1642862600833.png

Heures et Mn est affiché 17.3 et je souhaite avoir 2 chiffres après la virgule.
J'ai essayé de coder : "Heures et Mn" & vbTab & Dlm & Col("L") & .NumberFormat = "0.00" & vbLf & _
Mais vu mon niveau de nul :oops: ça ne marche pas ! :mad:

Vous pourriez me donner le bon code ?
Un grand merci de plus :)
lionel :)
 

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous :)
@fanch55
Merci pour ton code qui fonctionne super bien.

J'ai encore besoin d'une petit coupe de code :
1642929219181.png

Est-il possible d'inclure en codes les formules suivantes dans ton code pour que l'affichage en prenne la valeur et pour éviter que je doive les écrire dans la feuille ?

1- Date RdV (= valeur de la formule pour afficher 23 01 2022 (sans le 17.00)
'Formule actuellement en col M : =CNUM(GAUCHE(REMPLACER(REMPLACER(B2;3;1;"/");6;1;"/");10))
'code = "=VALUE(LEFT(REPLACE(REPLACE(ActiveCell.Offset(0, -6)),3,1,""/""),6,1,""/""),10))"

2 - Heures et MN = valeur de la formule pour afficher 17.00
'Formule actuellement en col M : =CNUM(REMPLACER(DROITE(TEXTE(B2;1);5);3;1;"."))
'code = "=VALUE(REPLACE(RIGHT(TEXT(ActiveCell.Offset(0, -6)),1),5),3,1,"".""))"

Encore merci et bon dimanche :)
lionel,
 

fanch55

XLDnaute Barbatruc
Salut Lionel,
VB:
        Msg = "Réseau" & vbTab & vbTab & Dlm & Col("E") & vbLf & _
              "Agent " & vbTab & vbTab & Dlm & Col("F") & vbLf & _
              "Date RdV" & vbTab & Dlm & Format(Col("B"), "dd/mm/yyyy") & vbLf & _
              "Heures et Mn" & vbTab & Dlm & Format(Col("B"), "hh:mm") & vbLf & _
              "Date Appel" & vbTab & Dlm & Col("C") & vbLf & _
              "Intervalle" & vbTab & vbTab & Dlm & Abs(DateDiff("d", Col("B"), Col("C"))) & vbLf & vbLf & _
              "ENVOI ? = OUI        ou      NON"
 

Discussions similaires

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.