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

  • forum_test.xlsm
    47.3 KB · Affichages: 8
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...

patricktoulon

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

TooFatBoy

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

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

patricktoulon

XLDnaute Barbatruc
@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

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

XLDnaute Barbatruc
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:

Discussions similaires

Statistiques des forums

Discussions
312 338
Messages
2 087 403
Membres
103 536
dernier inscrit
komivi