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]

re
Tiens comme ca vite fait

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
Regarde la pièce jointe 1128513

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

Bien fait pour toi car tu ne veux que faire plaisir à fanch55 mais je te remercie quand même lol

 

[patricktoulon]

@fanch55 donne moi l'array en code

 

[fanch55]

@fanch55 donne moi l'array en code

Sub testx5()
    Dim t
    t = Array("il", "ne faut", "pas", "pousser", "Grand-mère dans les orties")
    MsgBox ArrayInTextColumVBTAB2(t)
End Sub

 

[patricktoulon]

ok
regarde bien cette capture

j'ai modifié le code

Function ArrayInTextColumVBTAB2(t)
    Dim texte$, minus&, maxi&, Mask$, fois&
     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
         If Len(t(i)) < minus Then minus = Len(t(i)) 'on determine la longeur de chaine la plus petite
         Next
       If maxi / minus > 4 Then fois = 2 Else fois = 1
       Mask = Application.Rept(" ", (maxi * fois) + 3)
       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 irégularités des espacement de caracteres selon les mots
     Next
     Debug.Print Join(t2, vbCrLf)
    ArrayInTextColumVBTAB2 = Join(t2, vbCrLf)
End Function

je pense que l'on a une limite avec les msgbox puisque dans le debug on est bon

 

[fanch55]

je pense que l'on a une limite avec les msgbox puisque dans le debug on est bon

C'est vrai, debug conforme mais msgbox pas glop .

 

[patricktoulon]

tiens c'est un ersatz de mon msgboxX comme ça vite fait
un spécial Lionel et fanch55
testez les deux sub tests et regardez ce qui se passe

 

[Usine à gaz]

tiens c'est un ersatz de mon msgboxX comme ça vite fait
un spécial Lionel et fanch55
testez les deux sub tests et regardez ce qui se passe

He enfin ! c'est aussi pour lionel lol. Merci Patrick

 

[patricktoulon]

test1

test 2

comme tu peux le voir le msgbox s'adapte en taille tout seul

 

[TooFatBoy]

comme tu peux le voir le msgbox s'adapte en taille tout seul

Certes, ça s'adapte, mais hélas ça ne le fait pas correctement.


Je ne sais pas si ça vient de la même erreur que dans ton calcul de résolution de l'affichage, mais pour information chez moi ça donne ça :

Et si on écrit "village" correctement, ça ne modifie pas la ligne du "tromblon" mais celle de "toto" et ça donne ça :

 

[patricktoulon]

bonjour @Marcel32
font tahoma d'origine a 11 points

Sub test3()
    t = Array("toto", "titi", "riri", "gaston", "henry", "charles xavier", "le tromblon du vilage")
    tx = Array("des bannanes", "des pommes", "des poires,des grillottes,des mures et des groseille", "des oranges", "des cerises", "des framboises", "des kakis")
    texte = ArrayInTextColumVBTAB2(t, tx)
    reponse = MsgboxX.showX(texte & vbCrLf & vbCrLf & "mangez vous de ces fruits vous aussi?", "question pour un champion")
    Select Case reponse
    Case vbOK: MsgBox "vous avez repondu oui"
    Case vbNo:: MsgBox "vous avez repondu non"
    End Select
End Sub

 

[patricktoulon]

re

 

[TooFatBoy]

Pas mieux.

Toujours problème de dimensionnement de la TextBox, d'alignement du texte et de positionnement des boutons :

 

[patricktoulon]

pour ceux qui n'ont pas w7
changez ces lignes et les boutons ne devraient plus etre mal placésje l'oublie souvent mais la logique ici est d'utiliser le inside

 With .BtNo: .Left = MsgboxX.InsideWidth - .Width - 5: .Top = MsgboxX.message.Height + 5: End With
        With .BtOk: .Left = MsgboxX.InsideWidth - (.Width * 2.3) - 5: .Top = MsgboxX.message.Height + 5: End With

 

[TooFatBoy]

C'est mieux !

En tâtonnant encore un peu on devrait arriver à avoir quelque chose de correct pour les boutons.

Pour la hauteur de la TextBox on doit aussi pouvoir arriver à un truc correct en fonction du nombre de lignes.

Mais pour l'alignement du texte ça semble plus difficile car la police de caractères n'est pas à chasse fixe, comme le disait Fanch55 en #18.

 

[fanch55]

pour ceux qui n'ont pas w7
changez ces lignes et les boutons ne devraient plus etre mal placésje l'oublie souvent mais la logique ici est d'utiliser le inside

 With .BtNo: .Left = MsgboxX.InsideWidth - .Width - 5: .Top = MsgboxX.message.Height + 5: End With
        With .BtOk: .Left = MsgboxX.InsideWidth - (.Width * 2.3) - 5: .Top = MsgboxX.message.Height + 5: End With

W11/Excel 2019