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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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

Solution
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...
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
1643130400072.png
 
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. 😁
 
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 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
 
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
 
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
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
72
Affichages
1 K
Retour