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

Usine à gaz

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
fanch55
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...
Trier par date Trier par votes
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Salut Fanch,
LOL, j'en ai encore une autre :
Dans mon fichier de travail le texte "Agent" est toujours plus long que dans le fichier test.

J'aurais souhaite cet affichage quel que soit le texte :
1642978812920.png

VB: 
Sub cherche4()
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("A") & vbLf & 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 & _
              "                                       ENVOYER ?    :  OUI        ou        NON"
    
        If MsgBox(Msg, vbQuestion + vbYesNo, T & "> " & Col("A") & " <" & T) <> vbNo _
        Then Col("H") = "Envoyé" Else Col("H") = "Pas envoyé"
        [a1].Select
    End If
End Sub
Peut-être possible en codant pour que le texte soit toujours éloigné de X espaces de la droite ? ( pour que le "ou" soit toujours entre le OUI et le NON)
Je ne sais pas faire ça.
Le saurais-tu ?
Je cherche .....
lionel :)
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour
tu a déjà commencé a tabuler ton texte ; ben continue ;)
VB: 
Sub cherche6()
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 & vbTab & Dlm & Format(Col("B"), "dd/mm/yyyy") & vbLf & _
              "Heure  du RdV" & vbTab & Dlm & Format(Col("B"), "hh:nn") & vbLf & _
              "Date Appel" & vbTab & Dlm & Col("C") & vbLf & _
              "Intervalle" & vbTab & vbTab & Dlm & Abs(DateDiff("d", Col("B"), Col("C"))) & vbLf & vbLf & _
              vbTab & vbTab & "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
1643014917683.png
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Patrick a tout bon . ;)

Attention aux champs à rallonge, la taille maximale du msgbox est de 1024 caractères selon l'aide ( perso je n'ai jamais pu caser plus de 1023 .... ) , Nota: les caractères "spéciaux" tels que vbtab ou vblf ne comptant pas !!!

Pour faire un message type tableau et la police par défaut étant proportionnelle ,
utiliser le nombre de vbtab entre chaque champs qui va bien.
L'ajustage est de type visuel donc manuel, je n'ai jamais réussi à le faire automatiquement

Sinon passer par un msgbox personnel, de nombreux exemples existent ...
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Il faudrait essayer de trouver une bidouille au niveau d'Excel ou de Windows pour arriver à afficher deux MsgBox côte à côte (ou 3 MsgBox si tu as plus de 2046 caractères à afficher) pour pouvoir tout visualiser en même temps, car je crois qu'une MsgBox normale est préemptive.
Et il faudrait que la fermeture d'une des MsgBox ferme automatiquement l'autre (ou les autres).
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Marcel32 à dit:
Bonjour,

Il faudrait essayer de trouver une bidouille au niveau d'Excel ou de Windows pour arriver à afficher deux MsgBox côte à côte (ou 3 MsgBox si tu as plus de 2046 caractères à afficher) pour pouvoir tout visualiser en même temps, car je crois qu'une MsgBox normale est préemptive.
Et il faudrait que la fermeture d'une des MsgBox ferme automatiquement l'autre (ou les autres).
Cliquez pour agrandir...
Bonjour Marcel,
Ce serait génial :)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Tiens comme ca vite fait
Après plus d'une heure à tester différente solution,
j'abandonne l'idée d'automatiser les vbtab, il n'y a pas vraiment de règle universelle , c'est trop dépendant de la police et des caractères utilisés . 😵‍💫
Cliquez pour agrandir...
bien sur que si il y a une règle universelle
allez je faire plaisir a @fanch55 et les autres aussi en passant
le truc c'est qu'il faut formater les chaine pour quel ai un len identique ensuite on ajoute un seul vbtab
pour cela on utilisera un mask
pour obtenir ce mask je boucle sur tout les chaine pour recuperer la longeur la plus longue
avec ce nombre je créée un mask d'espace
je boucle sur l'array de chaine
et je met la valeur de la chaine dans le mask en lieu et place de la chaine original

allez démonstration
demo.gif



VB: 
Sub testx1()
    Dim t
    t = Array("toto la frite", "toto", "fanch55", "patricktoulon")
     MsgBox ArrayInTextColumVBTAB2(t)
End Sub
Sub testx2()
    Dim t
    t = Array("toto", "fanch55", "patricktoulon", "trucmuche", "machin", "blablablablabla")
   MsgBox ArrayInTextColumVBTAB2(t)
End Sub
Sub testx3()
    Dim t
    t = Array("robert", "fanch55", "patricktoulon", "charles", "machin", "henry")
    MsgBox ArrayInTextColumVBTAB2(t)
End Sub
Sub testx4()
    Dim t
    t = Array("camion", "voiture", "poid lourd", "bateau", "canoé", "barque")
    MsgBox ArrayInTextColumVBTAB2(t)
End Sub

Function ArrayInTextColumVBTAB2(t)
'patricktoulon 
   Dim texte$, maxi&, Mask$
     minus = Len(Join(t)): maxi = 0
    For i = 0 To UBound(t)
        If Len(t(i)) > maxi Then maxi = Len(t(i)) 'on determine la longeur de chaine la plus longue
         Next
       Mask = Application.Rept(" ", maxi + 2)
       ReDim t2(UBound(t))
        For i = 0 To UBound(t)
        t2(i) = Mask 'on met le mask d'espace a chaque tour  dans l'item du tableau 2
        Mid(t2(i), 1, Len(t(i))) = t(i) 'on met la valeur en lieu et place dans le masck avec mid on garde donc les espaces restants
        t2(i) = t2(i) & vbTab & ":aligné" ' et on ajoute enfin la tabulation pour formater les irrégularités des espacement de caracteres selon les mots
     Next
    Debug.Print Join(t2, vbCrLf)
    ArrayInTextColumVBTAB2 = Join(t2, vbCrLf)
End Function

c'est @fanch55 qui va être contant ;)
plus de 2 heures pour trouver le truc j'ai essayé des dizaines de règles pour trouver celle ci qui est ma fois après coup la seule valable
bon maintenant a cause de toi Lionel, j'ai mal a la tête
voilà mon cher @fanch55😁 un petit + dans ton brain tool
 
Vote positif 0 Vote négatif

Discussions similaires

Fredox
  • Question
Microsoft 365 [Résolu] | Ribbon | Afficher/Masquer le Ruban selon la feuille active
Réponses
9
Affichages
606
patricktoulon
patricktoulon
N
  • Question
Microsoft 365 Alimenter une Combo Active X inséré dans une feuille de calcul
Réponses
3
Affichages
87
NONO14
N
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
325
Nel'
N
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
112
AlCapone
AlCapone
M
  • Question
Microsoft 365 Envoi (mail) d'une seule feuille de calcul (active) en pdf
Réponses
7
Affichages
995
patricktoulon
patricktoulon
J
  • Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
435
Julien_B
J
Usine à gaz
  • Résolu(e)
XL 2021 En restant sur Feuille 1 active, comment activer dans ma feuille2 la 1ère cellule vide de la colonne A
2
Réponses
29
Affichages
1 K
TooFatBoy
TooFatBoy
T
  • Question
Microsoft 365 vba : nom de tableau si feuille non active
Réponses
13
Affichages
553
thenesol
T
Nicolas JACQUIN
  • Question
XL 2021 Création et adaptation barre de progression
2 3
Réponses
44
Affichages
1 K
Tartine
T
O
  • Question
XL 2010 Besoin d'aide Excel pour Expert - récupérer données sur une autres feuille
Réponses
8
Affichages
399
AtTheOne
AtTheOne

Membres actuellement en ligne

13 membres et 84 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 646
Messages
2 111 528
Membres
111 190
dernier inscrit
clmtj