XL 2021 Savez-vous planter les choux ?

Créer une discussion
Répondre

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 !

S'inscrire
C

Constantin

XLDnaute Occasionnel
Supporter XLD
Bonjour à tous,
A la demande d'aspsy et sur les conseils de sylvanu, j'ai repris un fichier pour le compléter façon jardinier.
J'ai ainsi ajouté (partiellement) , dans la BaseJM, l'Oca du Pérou (travail en cours)
- Problème 1 : Je n'arrive pas à importer la photo de l'Oca dans le rapport. J'ai vu que JM27 avait expliqué comment faire mais, comme à mon habitude, je n'ai pas réussi.(explications trop succinctes pour un balbutiant comme moi)
- Problème 2 : L'affichage du (des) tableaux mentionnent "Réalisation:Jean-Marcel.H"=JM27 d'XLD ?). J'aimerai placer cette annotation dans un endroit qui ne gêne pas mais je suis incapable de le voir dans l'UserForm.

Je numérote les problèmes parce qu'il y en aura d'autres à venir...
Bien à vous,
 

Pièces jointes

Solution
JM27
@cathodique
Effectivement je pense que ma version ( qui est la dernière) n'est pas compatible avec la tienne.
j'ai bien vu que tu n'as pas effacé le nom de l'auteur mais que tu as traité différemment.
Attention Constantin : ce message s'adresse à Cathodique.😀
ne viens donc pas le parasité.
Trier par date Trier par votes
@cathodique
Merci de ne pas supprimer le label nom de l'auteur.( c'est un minimum)😀
nota: JM27 = Jean-Marcel H
pourquoi ne pas l'avoir laissé comme c'était. ( les label étant créer par programme et non en dur comme tu l'as fait)
nota: chez moi ton fichier plante.
Capture d’écran 2026-02-23 180752.jpg
Capture d’écran 2026-02-23 180720.jpg
 
Dernière édition:
Vote positif 0 Vote négatif
JM27 à dit:
@cathodique
Merci de ne pas supprimer le label nom de l'auteur.( c'est un minimum)😀
pourquoi ne pas l'avoir laissé comme c'était. ( les label étant créer par programme et non en dur comme tu l'as fait)
nota: chez moi ton fichier plante.Regarde la pièce jointe 1228068Regarde la pièce jointe 1228067
Cliquez pour agrandir...
Tu n'as décidément rien compris ?
Il n'est en aucun cas le désir de te priver de ta légitimité de création de ce bel outil! Je veux juste que cette information légitime ne me fasse pas chier dans un autre visu et reste à sa place, en bas(en gros visible mais pas chiante, puisqu'il faut parler franc).
Mégalo à outrance ?
Je plaisante, mais je vais tenir compte de tes commentaires et, si Dieu (lequel ?) le veut, j'en ferais quelque-chose...
Passionnant en tous les cas.
Je suppose que je dois agir sur le paramètre "-16"?
Je ne sais même pas ce que cela veut dire
Un rameur sachant nager doit savoir nager sans ramer... C'est loin d'être le cas!
Bye
 
Vote positif 0 Vote négatif
@Constantin
Tu n'as décidément rien compris ?
Cliquez pour agrandir...
tu as raison de me prendre pour un imbécile( ou pas) https://excel-downloads.com/threads/savez-vous-planter-les-choux.20089133/page-2#post-20710330
1/ le message ne s'adressait pas à toi mais à cathodique.
Je pense que celui qui n'a rien compris : c'est toi.
Mais vu ton comportement terminé pour moi.
Avant d'agir essayes de réfléchir un petit peu, je sais cela doit être dur pour toi!
Pour info : certains se sont approprié de mes appli et l'on posté sur leur site moyennant rémunération.
normalement je bétonne le code et le rend inaccessible pour en limiter l'accès. (c'est ce que tu souhaites ?)
 
Dernière édition:
Vote positif 0 Vote négatif
JM27 à dit:
@cathodique
Merci de ne pas supprimer le label nom de l'auteur.( c'est un minimum)😀
nota: JM27 = Jean-Marcel H
pourquoi ne pas l'avoir laissé comme c'était. ( les label étant créer par programme et non en dur comme tu l'as fait)
nota: chez moi ton fichier plante.Regarde la pièce jointe 1228068Regarde la pièce jointe 1228067
Cliquez pour agrandir...
ma machine fonctionne sous win7 64bits et Excel 2010 32bits. C'est sûrement un problème de compatibilité.
Je n'ai pas supprimé le label nom de l'auteur, il était tout à fait au bas des 3 pages.
Moi aussi, c'est fini pour moi. On aide bénévolement et on se fait cracher dessus.
 
Vote positif 0 Vote négatif
@cathodique
Effectivement je pense que ma version ( qui est la dernière) n'est pas compatible avec la tienne.
j'ai bien vu que tu n'as pas effacé le nom de l'auteur mais que tu as traité différemment.
Attention Constantin : ce message s'adresse à Cathodique.😀
ne viens donc pas le parasité.
 
Vote positif 0 Vote négatif
Solution
JM27 à dit:
@Constantin
1/ le message ne s'adressait pas à toi mais à cathodique.
Je pense que celui qui n'a rien compris : c'est toi.
Mais vu ton comportement terminé pour moi.
Avant d'agir essayes de réfléchir un petit peu, je sais cela doit être dur pour toi!
Pour info : certains se sont approprié de mes appli et l'on posté sur leur site moyennant rémunération.
normalement je bétonne le code et le rend inaccessible pour en limiter l'accès. (c'est ce que tu souhaites ?)
Cliquez pour agrandir...
Que veux-tu que je te dise? Je n'arrête pas de recevoir des messages déplaisants de nouveaux XLDNautes. Je n'ai jamais insulté personne. Il est vrai que je peux me perdre (comme vous tous d'ailleurs) dans les réponses. Mais les réponses à la "con" de ces nouveaux "membres" me fâchent !
Bon, tu me lâches? Je peux le comprendre, je ne suis pas bon (euphémisme) . Tu diras ce que tu voudras, mais ton fichier est susceptible d'amélioration(s). Tu l'as montré et ta V5 en est un bel exemple. Pourquoi s'arrêter ?
Quand tu dis que je n'ai rien compris, c'est possible :
- j'ai pu rater un post
- je n'ai peut-être pas bien compris les "explications".
Tu te fâches parce que je veux déplacer cette information relative à ta paternité. Je ne la conteste en aucun cas, mais je ne veux pas qu'elle s'affiche n'importe où.
Et c'est pour ça qu'on s'engueule ? Quelle misère...
 
Vote positif 0 Vote négatif
Bonjour,

JM27 à dit:
Effectivement je pense que ma version ( qui est la dernière) n'est pas compatible avec la tienne.
Cliquez pour agrandir...
@JM27 😉, Stp quelle est ta version Windows et office.
Je ne fais pas parti de ceux qui maitrise parfaitement le codage.
Cependant, mes réalisations finissent toujours par bien fonctionner.
Je ne lâche presque jamais le morceau.
Je vais essayer de rendre le code de @patricktoulon compatible.
J'espère réussir. Cela Rendrait service à beaucoup de personne.

bonne journée.

ps: pour ma part @Constantin est déjà dans ma liste "des ignorés"
(dommage, il n'a rien compris à la "philosophie" de fonctionnement de XLD. Il devrait relire très attentivement la charte du forum)
 
Vote positif 0 Vote négatif
JM27 à dit:
Bonjour
@cathodique
Microsoft® Excel® pour Microsoft 365 MSO (Version 2601 Build 16.0.19628.20214) 64 bits
Cliquez pour agrandir...
Bonjour @JM27 ,

Tu es au top. Je suis à traine faute de moyen.
Je te confie que je suis dégouté de ce fil à cause des réactions de l'initiateur.
J'ai envoyé un code en mp, pondu par ChatGpt à @patricktoulon.
Il n'y a pas cette possible de t'envoyer un mp.
Patrick m'a informé que chatgpt m'a donné des absurdités.

je ne posterai aucune réponse dans ce fil, car j'ai été littéralement insulté par @Constantin à 2 reprises en message privé.

Bonne journée.
 
Vote positif 0 Vote négatif
re
ne pas en vouloir à cathodique il a fait confiance en chat gpt
et les modifs de chatgpt sont stupéfiantes tellement c'est stupide
c'est incroyable comme chatgpt a tricoté mon code simple ou il fallait seulement ajouter les déclaration 64 en un truc sans nom

je suis estomaqué

allez
je vous donne le vieux machin pour ceux pour qui ca pesent trop de devoir se depatouiller avec les déclarations d'api
VB: 
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                            Module RESIZER  userform version basic
'version  avec api en macro 4
'release 2020  for XLD
'****************************************************************************************************
Option Explicit

Dim OldW#, OldH#
Sub trois_boutons1() 'ajoute les 3 boutons et le resize dynamique à l'userform
    Dim hWnd&
    hWnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hWnd & ", " & -16 & ", " & &H94CF0080 & ")") 'api SetWindowLongA
End Sub
Sub NoTitleBar1() 'supprime la barre de titre( rempli absolument tout l'ecran
    Dim hWnd&
    hWnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hWnd & ", " & -16 & ", " & &H140F0101 ")") 'api SetWindowLongA
End Sub

Sub UsfFullScreen1() 'met le userform en plein ecran
    Dim hWnd&
    hWnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""ShowWindow"",""JJJ""," & hWnd & ", 3)") 'api SetWindowLongA
End Sub

Sub memoControlSize1(usf) 'on memorise dans le tag des controls leur position et dimension
    Dim CtrL
    OldW = usf.Width
    OldH = usf.Height
    For Each CtrL In usf.Controls
        CtrL.Tag = CtrL.Left & ";" & CtrL.Top & ";" & CtrL.Width & ";" & CtrL.Height
        On Error Resume Next
        CtrL.Tag = CtrL.Tag & ";" & CtrL.Font.Size
        CtrL.Tag = CtrL.Tag & ";"
        Err.Clear: On Error GoTo 0
        If TypeName(CtrL) = "ListBox" Or TypeOf CtrL Is ListBox Then
            CtrL.Tag = CtrL.Tag & ";" & Replace(CtrL.ColumnWidths, ";", "|")
        End If
        CtrL.Tag = CtrL.Tag & ";"
    Next
End Sub

Sub resiZer1(usf)
    Dim newW#, NewH#, t, cw$, tc, CtrL, i&
    newW = usf.Width / OldW
    NewH = usf.Height / OldH
    For Each CtrL In usf.Controls
        t = Split(CtrL.Tag, ";")
        CtrL.Move t(0) * newW, t(1) * NewH, t(2) * newW, t(3) * NewH
        If TypeName(CtrL) = "ListBox" Or TypeOf CtrL Is ListBox Then
            If CtrL.ColumnWidths = "" Then cw = Application.Rept("80", CtrL.ColumnCount) Else cw = CtrL.ColumnWidths
            tc = Split(t(6), "|")
            For i = 0 To UBound(tc): tc(i) = Val(tc(i)) * Application.Min(newW, NewH): Next
            CtrL.ColumnWidths = Join(tc, ";")
        End If
        On Error Resume Next
        CtrL.Font.Size = t(4) * Application.Min(newW, NewH)
        Err.Clear: On Error GoTo 0
    Next
End Sub

et maintenat le même exactement avec les api déclarées en bon et due forme
VB: 
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                            Module RESIZER  userform version basic
'version  avec api déclarées
'release 2020  for XLD
'****************************************************************************************************

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" ( _
                              ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" ( _
                              ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                              ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    
    Public Declare PtrSafe Function ShowWindow Lib "user32" ( _
                              ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
    
    Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    
#Else
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
                              ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                              ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
    Public Declare Function ShowWindow Lib "user32" ( _
                              ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    
    Public Declare Function GetActiveWindow Lib "user32" () As Long
    
#End If

Dim OldW#, OldH#

Sub trois_boutons() 'ajoute les 3 boutons et le resize dynamique à l'userform
    Dim hWnd&
    hWnd = GetActiveWindow
    SetWindowLongPtr hWnd, -16, &H94CF0080 'api SetWindowLongA
End Sub

Sub NoTitleBar() 'supprime la barre de titre( rempli absolument tout l'ecran
    Dim hWnd&
    hWnd = GetActiveWindow
    SetWindowLongPtr hWnd, -16, &H140F0101
End Sub

Sub SameSizeApplication(usf) 'taille et position identique à l'application
    With Application
        usf.Move .Left, .Top, .Width, .Height
    End With
End Sub

Sub UsfFullScreen() 'met le userform en plein ecran
    Dim hWnd&
    hWnd = GetActiveWindow
    ShowWindow hWnd, 3
End Sub

Sub memoControlSize(usf) 'on memorise dans le tag des controls leur position et dimension
    Dim CtrL
    OldW = usf.Width
    OldH = usf.Height
    For Each CtrL In usf.Controls
        CtrL.Tag = CtrL.Left & ";" & CtrL.Top & ";" & CtrL.Width & ";" & CtrL.Height
        On Error Resume Next
        CtrL.Tag = CtrL.Tag & ";" & CtrL.Font.Size
        CtrL.Tag = CtrL.Tag & ";"
        Err.Clear: On Error GoTo 0
        If TypeName(CtrL) = "ListBox" Or TypeOf CtrL Is ListBox Then
            CtrL.Tag = CtrL.Tag & ";" & Replace(CtrL.ColumnWidths, ";", "|")
        End If
        CtrL.Tag = CtrL.Tag & ";"
    Next
End Sub

Sub resiZer(usf)
    Dim newW#, NewH#, t, cw$, tc, CtrL, i&
    newW = usf.Width / OldW
    NewH = usf.Height / OldH
    For Each CtrL In usf.Controls
        t = Split(CtrL.Tag, ";")
        CtrL.Move t(0) * newW, t(1) * NewH, t(2) * newW, t(3) * NewH
        If TypeName(CtrL) = "ListBox" Or TypeOf CtrL Is ListBox Then
            If CtrL.ColumnWidths = "" Then cw = Application.Rept("80", CtrL.ColumnCount) Else cw = CtrL.ColumnWidths
            tc = Split(t(6), "|")
            For i = 0 To UBound(tc): tc(i) = Val(tc(i)) * Application.Min(newW, NewH): Next
            CtrL.ColumnWidths = Join(tc, ";")
        End If
        On Error Resume Next
        CtrL.Font.Size = t(4) * Application.Min(newW, NewH)
        Err.Clear: On Error GoTo 0
    Next
End Sub

voila le resize est tout totomatic
vous pouvez tester avec ce classeur il y a 3 userform exemples

l'userform1 utilisera le module avec la methode par les macro4(plein ecran, les trois boutons dans la barre de titre et la taskbar est visible)
l'userform2 utilisera le module avec api déclarées(plein ecran, pas de barre de titre, pas de taskbar(il couvre absolument tout l'ecran)
l'userform3 utilisera le module api déclarées(couvre l'application ,pas de barre de titre )

un peu d'humour
@Nain porte quoi
non on ca plait au nazes
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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
Retour