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

[Usine à gaz]

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

 

[Usine à gaz]

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 :

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

 

[patricktoulon]

Bonjour
tu a déjà commencé a tabuler ton texte ; ben continue

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

 

[fanch55]

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

 

[patricktoulon]

Bonjour @fanch55
1023 car il y a un chr(0) toujours devant

l'alignement automatique avec les vbtab se calcul si la chaîne précédente est plus longue que la chaine suivante 1 vbtab sinon 2
on fait ça dans une boucle

 

[fanch55]

Bonjour @fanch55
l'alignement automatique avec les vbtab se calcul si la chaîne précédente est plus longue que la chaine suivante 1 vbtab sinon 2
on fait ça dans une boucle

OK, je vais tester par curiosité, un petit + dans mon brain tool, merci Patrick​

 

[fanch55]

@patricktoulon
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 .

@Usine à gaz
Pourquoi vouloir mettre la phrase "ENVOI ? = OUI ou NON",
"Envoyer" suffit les boutons étant assez explicite ???

 

[Usine à gaz]

Bonjour Fanch, Bonjour Patrick, le Forum,

Merci d'avoir répondu
"Pourquoi vouloir mettre la phrase "ENVOI ? = OUI ou NON""
Il me semble que c'est plus clair mais c'est peut-être pas une bonne idée lol
lionel,

 

[Usine à gaz]

Re-Bonjour
Jusque-là, ça passe :

Au-delà, ça ne passe plus Grrrrrrr !!!
lionel

 

[fanch55]

Re-Bonjour
Jusque-là, ça passe :
Regarde la pièce jointe 1128500
Au-delà, ça ne passe plus Grrrrrrr !!!
lionel

Limite des 1023 cars ....

M'enfin, un msgbox c'est un message informatif, pas un document ...

 

[TooFatBoy]

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).

 

[Usine à gaz]

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).

Bonjour Marcel,
Ce serait génial

 

[patricktoulon]

re
dans ce cas la passer par un msgbox perso
avec un userform vous galérerez moins
je donne un indice msgboxX
LOL

 

[Usine à gaz]

re
dans ce cas la passer par un msgbox perso
avec un userform vous galérerez moins
je donne un indice msgboxX
LOL

Merci Patrick
Je vais voir ça aussi

 

[patricktoulon]

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 .

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

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

 

[fanch55]