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

Usine à gaz · 21 Janvier 2022

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

fanch55 · 22 Janvier 2022

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 · 22 Janvier 2022

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

Phil69970 · 22 Janvier 2022

Bonjour @Usine à gaz
Edit : Bonjour Laurent
Pas rafraichi et donc j'ai pas vu ta réponse

Lionel je te propose ce fichier

*Merci de ton retour

@Phil69970

Usine à gaz · 22 Janvier 2022

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

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

Phil69970 · 22 Janvier 2022

Re

Lionel

Ton fichier que tu nous as fourni au post #1 lorsque l'on rentre la macro affiche cela :

Je n'avais pas compris les infos que tu voulais .....
On se calme je suis pas blond

L'horaire sans doute......

@Phil69970

Usine à gaz · 22 Janvier 2022

Bjr PHIL?
OUI c'est vrai mais c'était parce qu'il ne fonctionnait pas
Le voici en fonctionnel en pièce jointe mais pas sans quitter la feuille active

fanch55 · 22 Janvier 2022

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 · 22 Janvier 2022

Bonjour fanch55

Merci pour le code qui fonctionne parfaitement.
Un grand merci
Merci aussi à Laurent95 et à Phil69970 pour m'avoir aidé
Amicalement,
lionel

Usine à gaz · 22 Janvier 2022

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 :

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 ça ne marche pas !

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

fanch55 · 22 Janvier 2022

Usine à gaz à dit:
J'ai essayé de coder : "Heures et Mn" & vbTab & Dlm & Col("L") & .NumberFormat = "0.00" & vbLf & _

Comme je ne sais pas ce qu'est la col("L") :
Format(col("L"), "0.00")
Format(col("L"), "hh:mm")

Mais si c'est l'heure du rdv :
"Heures et Mn" & vbTab & Dlm & Split(Col("C"))(3) & vbLf & _

Usine à gaz · 22 Janvier 2022

Re
Merci à toi c'est tout bon

Usine à gaz · 23 Janvier 2022

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

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

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 · 23 Janvier 2022

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"

Usine à gaz · 23 Janvier 2022

Salut Fanch,

Merci d'être encore présent pour moi
Je teste et je reviens,
lionel,

Usine à gaz · 23 Janvier 2022

Re Fanch,

Magique : je te remercie

lionel

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

Pièces jointes

fanch55

laurent950

XLDnaute Accro

Phil69970

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires