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

patricktoulon à dit:

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

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

Cliquez pour agrandir...

patricktoulon à dit:

@fanch55 donne moi l'array en code

Cliquez pour agrandir...

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

patricktoulon à dit:

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

Cliquez pour agrandir...

patricktoulon à dit:

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

Cliquez pour agrandir...

patricktoulon à dit:

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

Cliquez pour agrandir...

patricktoulon à dit:

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

VB:

 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

Cliquez pour agrandir...