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

patricktoulon · 25 Janvier 2022

bonsoir @Marcel32 en fait c'est l’éternel problème de w7/w10 et 11
qui n'ont pas le même calcul de bordure des fenêtres

pour la chasse fixe c'est quand même étonnant si on utilise les mêmes
chez moi avec les deux nouvelles lignes

TooFatBoy · 25 Janvier 2022

patricktoulon à dit:
en fait c'est l’éternel problème de w7/w10 et 11
qui n'ont pas le même calcul de bordure des fenêtres

Oui, je sais bien.

Il doit y avoir un tout petit souci dans les calculs de la taille de la TextBox, parce qu'on voit sur #45 que la hauteur augmente trop selon le nombre de lignes à afficher.

Mais ce n'est que du peaufinage à effectuer, et c'est surtout Yoyo qui devrait s'en préoccuper.
Moi j'utilise des UserForm que je fabrique égoïstement pour mon PC, et qui sont donc au bon format pour mon PC.

patricktoulon · 25 Janvier 2022

re
@fanch55
je vois a tes capture que le meme probleme que @Marcel 32
a svoir que le textbox est dimentionné trop grand en terme de height et les bouton malgré le "-5" rest collé en bas
-5 c'est la largeur de bordure des coté et en bas pour W7 bordure que vous n'avez pas(tout du moins on ne la voit pas ) donc pour vous c'est -10
et pour le redim du textbox en terme de height pour vous c'est - la hauteur de la barre de titre soit -19
il faut que j'automatise ça

testez ça pour voir
remplacez la fonction showX

VB:

Public Function showX(mess, titre)
 Dim op#, t, i&, dch&, pcdh&
 op = Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1))
 If op > 6.01 Then dch = 19: pcdh = 10 Else pcdh = 5
    With MsgboxX
        .message.Value = mess
        t = Split(mess, vbCrLf)
        For i = 0 To UBound(t)
            If Len(t(i)) > mx Then mx = Len(t(i))
        Next
        .message.Width = mx * 6
        .message.Height = (UBound(t) * 20) - dch
        .Width = message.Width + 6
        .Height = message.Height + 50
        'With .BtNo: .Left = MsgboxX.InsideWidth - .Width - 5: .Top = MsgboxX.InsideHeight - 25: End With
        'With .BtOk: .Left = MsgboxX.InsideWidth - (.Width * 2.3) - 5: .Top = MsgboxX.InsideHeight - 25: End With
        With .BtNo: .Left = MsgboxX.InsideWidth - .Width - pcdh: .Top = MsgboxX.message.Height + pcdh: End With
        With .BtOk: .Left = MsgboxX.InsideWidth - (.Width * 2.3) - pcdh: .Top = MsgboxX.message.Height + pcdh: End With
       .Show
        showX = reponse
    End With
    Unload MsgboxX
End Function

fanch55 · 25 Janvier 2022

patricktoulon à dit:
re
@fanch55
testez ça pour voir
remplacez la fonction showX

Les Userforms sont moins haut

patricktoulon · 25 Janvier 2022

@fanch55 ok donc vous c'est l'inverse de W7 c'est 19 de caption-5 de bordure donc 19+5 et encore +5 pour pas qu'il soit coller en bas

VB:

Public Function showX(mess, titre)
 Dim op#, t, i&, dch&, pcdh&
 op = Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1))
 If op > 6.01 Then dch = 19: pcdh = 10 Else pcdh = 5
    With MsgboxX
        .message.Value = mess
        t = Split(mess, vbCrLf)
        For i = 0 To UBound(t)
            If Len(t(i)) > mx Then mx = Len(t(i))
        Next
        .message.Width = mx * 6
        .message.Height = (UBound(t) * 20) - dch - pcdh
        .Width = message.Width + 6
        .Height = message.Height + 50
        'With .BtNo: .Left = MsgboxX.InsideWidth - .Width - 5: .Top = MsgboxX.InsideHeight - 25: End With
        'With .BtOk: .Left = MsgboxX.InsideWidth - (.Width * 2.3) - 5: .Top = MsgboxX.InsideHeight - 25: End With
        With .BtNo: .Left = MsgboxX.InsideWidth - .Width - pcdh: .Top = MsgboxX.message.Height + pcdh - 5: End With
        With .BtOk: .Left = MsgboxX.InsideWidth - (.Width * 2.3) - pcdh: .Top = MsgboxX.message.Height + pcdh - 5: End With
       .Show
        showX = reponse
    End With
    Unload MsgboxX
End Function

fanch55 · 25 Janvier 2022

On brule ...

patricktoulon · 25 Janvier 2022

re
oui sauf que le petit il manque toto
elle est vraiment bizarre la logique des fenêtres sur W10 +

il faut que je prépare des tests que je vous donnerais demain pour bien déterminer les tailles

fanch55 · 25 Janvier 2022

Avec ce code , les boutons sont bien positionnés ( sur mon os ) :

VB:

Public Function showX(mess, titre)
Dim Y As Long

        message.Value = mess
        t = Split(mess, vbCrLf)
        For i = 0 To UBound(t)
            If Len(t(i)) > mx Then mx = Len(t(i))
        Next
        message.Width = mx * 6
        message.Height = UBound(t) * 20
        Me.Width = message.Width + 6
        
        BtNo.Move Me.InsideWidth - BtNo.Width - 5, message.Height + 5
        BtOk.Move BtNo.Left - BtOk.Width - 5, message.Height + 5
                
        Y = Me.BtNo.Top + Me.BtNo.Height + 5
        Me.Height = Y: Do While Me.InsideHeight < Y: Me.Height = Me.Height + 1: Loop

        Me.Show
        showX = reponse
        Unload Me
End Function

patricktoulon · 25 Janvier 2022

oui un do while pourquoi pas
regardez la différence entre textbox ( a gauche) et un label (a droite) avec le multiple à 15 comme ca devrait être et non 20

patricktoulon · 25 Janvier 2022

re
ah non!!
~~Me.Width = message.Width + 6~~
il doit Etre nommé explicitement
msgboxX.Width = message.Width + 6
car dans la fonction on est dans une classe userform pas dans le userform (object(form))

TooFatBoy · 25 Janvier 2022

Avec #50 les boutons sont visibles en entier.

patricktoulon · 25 Janvier 2022

si c'est bon pour tout le monde (le dowhile)
ça veut dire que chez vous la lecture des propriété est faussée
donc on garde comme ça
puisqu'on galope avec un do while plus besoins de op
code entier du userform

VB:

'********************************
'msgbox oui ou non perso
'version speciale pour  fanch55 et usine agaz
'methode userform function patricktoulon
'créateurs:'patricktoulon
'fanch55

'*******************************
Public reponse
Public Function showX(mess, titre)
    Dim t, i&, dch&, pcdh&
     With MsgboxX
        .message.Value = mess    'on met le text dans le textbox
        t = Split(mess, vbCrLf)    'on coupe le text par les saut de ligne
        For i = 0 To UBound(t)    'on boucle sur l'array obtenu par la coupe
            If Len(t(i)) > mx Then mx = Len(t(i))    'on détermine la longeur de texte la plus longue
        Next
        .message.Width = mx * 6    'on elargie le textbox avec la longeur de text fois 6 (6= le roundup du fontsize/2)
        .message.Height = (UBound(t) * 18) - dch - pcdh    'on dimentionne la hauteur du textbox par le nombre de ligne fois 18
        .Width = message.Width + 6    'on dimentionne le userform en largeur par raport au textbox +6( +6 bordure W7)
        .BtNo.Move Me.InsideWidth - BtNo.Width - 5, message.Height + 5    'position du bouton a 5 points en dessous le textbox et sa propre largeur
        .BtOk.Move BtNo.Left - BtOk.Width - 5, message.Height + 5    'position du bouton a 5 points en dessous le textbox et sa propre largeur+la largeur de l'autre bouton
        Y = .BtNo.Top + .BtNo.Height + 5    'on determine le point le plus bas apres les boutons +5
        .Height = Y: Do While .InsideHeight < Y: .Height = .Height + 1: Loop    'on boucle tant que le inside est < que le point le plus bas
        .Show
        showX = reponse
    End With
    Unload MsgboxX
End Function

Private Sub btok_Click(): reponse = vbOK: Me.Hide: End Sub
Private Sub BtNo_Click(): reponse = vbNo: Me.Hide: End Sub

TooFatBoy · 25 Janvier 2022

Avec #53, les boutons sont joliment affichés par rapport à la taille de la fenêtre :

PS : peux-tu enlever mon pseudo des commentaires, STP ?

patricktoulon · 25 Janvier 2022

tiens @Marcel32
teste les 3 d'un coup

patricktoulon · 25 Janvier 2022

si c'est bon pour tout le monde
je vous met le kit VbButton auto(vbok,vbyesno,vbretrycancel,etc.... comme dans mon msgboxX de la ressource
si mal aligné descendez de 11 à 9 pour le font.size (juste pour voir si ca change )

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

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires