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

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
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
fanch55
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...
Trier par date Trier par votes
patricktoulon

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
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
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
Cliquez pour agrandir...
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. 😁
 
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
fanch55

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
 
Vote positif 0 Vote négatif
patricktoulon

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:
Vote positif 0 Vote négatif

Discussions similaires

Fredox
  • Question
Microsoft 365 [Résolu] | Ribbon | Afficher/Masquer le Ruban selon la feuille active
Réponses
9
Affichages
606
patricktoulon
patricktoulon
N
  • Question
Microsoft 365 Alimenter une Combo Active X inséré dans une feuille de calcul
Réponses
3
Affichages
87
NONO14
N
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
325
Nel'
N
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
112
AlCapone
AlCapone
M
  • Question
Microsoft 365 Envoi (mail) d'une seule feuille de calcul (active) en pdf
Réponses
7
Affichages
995
patricktoulon
patricktoulon
J
  • Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
435
Julien_B
J
Usine à gaz
  • Résolu(e)
XL 2021 En restant sur Feuille 1 active, comment activer dans ma feuille2 la 1ère cellule vide de la colonne A
2
Réponses
29
Affichages
1 K
TooFatBoy
TooFatBoy
T
  • Question
Microsoft 365 vba : nom de tableau si feuille non active
Réponses
13
Affichages
553
thenesol
T
Nicolas JACQUIN
  • Question
XL 2021 Création et adaptation barre de progression
2 3
Réponses
44
Affichages
1 K
Tartine
T
O
  • Question
XL 2010 Besoin d'aide Excel pour Expert - récupérer données sur une autres feuille
Réponses
8
Affichages
399
AtTheOne
AtTheOne

Membres actuellement en ligne

10 membres et 118 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 647
Messages
2 111 533
Membres
111 195
dernier inscrit
Cheminotbelgiantrain