1. #21
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    Bonjour unparia
    depuis quelle version
    j'utilise 2003 2007 2010 et je l'ai la listview sans modifier quoi que se soit

    boite a outils, outils supplémentaire, listview
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  2. #22
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    avril 2017
    Messages
    41
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : avril 2017
    Messages : 41
    Points : 22
    Points
    22

    Par défaut

    Citation Envoyé par unparia Voir le message
    Bonjour
    Des raisons de sécurité/vulnérabilité ont fait que des mises à jour de Microsoft Office n'ont pas supprimé certains composants (dont la listview, au passage), mais les ont rendus non automatiquement disponibles depuis Excel.
    Pour les rendre à nouveau disponibles (à ses risques et périls) l'utilisateur doit expressément intervenir sur une clé (par composant concerné) de la base de registre de Windows.
    Bonjour,
    est-ce que ça veut dire que l'utilisateur devra faire une manip une fois l'application livrée ?

  3. #23
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    pour la listeview non
    une fois que le fichier a été enregistré avec la listview il la garde
    tu veux la voir l'astuce avec le webbrowser????
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  4. #24
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Citation Envoyé par patricktoulon Voir le message
    Bonjour unparia
    depuis quelle version
    j'utilise 2003 2007 2010 et je l'ai la listview sans modifier quoi que se soit

    boite a outils, outils supplémentaire, listview
    Tu m'as montré très récemment que tu aimais parler anglais (j'avais réagi en espagnol) ?
    Alors lis déjà ceci (je parle aussi anglais .. )
    https://darrenmyher.com/2016/01/14/m...nuary-12-2016/
    Et tout n'y est pas dit ...
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  5. #25
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    re
    bonsoir a tous
    allez cadeau
    voici un exemple
    une listbox a plusieurs colonne dimensionnée comme la plage source
    dans le userform tu a un bouton il ne reste plus qu'a cliquer dessus et tu ton sapin de noel
    c'est une ébauche hein ne m'en veux pas j'ai plusieurs projet sur le feu
    on gagne entre autre la roulette souris absente pour la listbox ,la gestion ligne/colonne
    je montre le code dans le module userform
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    Dim cl As New listboxfuny
    Private Sub CommandButton1_Click()
     'la construction démarre de la en fesa,nt appel a la classe 
    Dim couleurcolonne, couleurmot, mot
        couleurcolonne = Array(&HFF8080, &HC0C0&, &H80FF&, &HC0FFFF, &HC0C0FF, &HC0C0C0, &H8080FF, &HFF80FF, &HFF&)
        mot = Array("activated", "cadre", "toto")
        couleurmot = Array(vbRed, vbCyan)
        cl.substitut Me.ListBox1, couleurcolonne, mot, couleurmot
    End Sub
     
    Private Sub ListBox1_Change()
    With ListBox1
    If .Tag <> "" Then
    t = "ligne index = " & .ListIndex & vbCrLf
    t = t & "colonne index  = " & Split(.Tag, ":")(1) & vbCrLf
    t = t & "valeur = " & .list(.ListIndex, Split(.Tag, ":")(1))
    MsgBox t
    .Tag = ""
    End If
    End With
    End Sub
    Private Sub UserForm_Activate()
        Set plage = Sheets(1).Range("A1:i20")
        For c = 1 To plage.Columns.Count
            colonwidth = colonwidth & Round(plage.Columns(c).Width) & " pt" & IIf(c < plage.Columns.Count, ";", "")
        Next
        With ListBox1
            .ColumnCount = plage.Columns.Count
            .list = plage.Value
            .ColumnWidths = colonwidth
        End With
        'MsgBox colonwidth
    End Sub
    voila maintenant la classe que j'ai nommé "listboxfuny"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    Option Explicit
    Public WithEvents weblist As WebBrowser
    Public WithEvents formm As UserForm
    Public WithEvents listeb As MSForms.ListBox
    Private usf As New listboxfuny
    Function substitut(liste, colcoul, mot, coulmot)
        Dim TR, TD, Lig, Col, swidth, scR, op, sweb, Table, code, meta, lescript, lestyle
        If liste.ColumnWidths <> "" Then swidth = Split(Replace(liste.ColumnWidths, " pt", ""), ";")
        op = Pt_To_Px
        Set sweb = liste.Parent.Controls.Add("Shell.Explorer.2", "webctl", True)
        Set usf.formm = liste.Parent: Set usf.weblist = sweb: Set usf.listeb = liste
        With CreateObject("htmlfile")
            Set Table = .createelement("TABLE")
            Table.Style.FontSize = liste.Font.Size * op + 2: Table.Style.Width = "100%"
            .body.appendchild (Table)
            For Lig = 0 To liste.ListCount - 1
                Set TR = .createelement("TR")
                For Col = 0 To liste.ColumnCount - 1
                    Set TD = .createelement("TD")
                    With TD.Style:
                        If liste.ColumnWidths <> "" Then .Width = Round((swidth(Col) * op)) & "px":
                        .Border = "1px solid " & coul_XL_to_coul_HTMLX(&H808080)
                        .backgroundcolor = coul_XL_to_coul_HTMLX(colcoul(Col))
                    End With
                    If liste.list(Lig, Col) <> "" Then TD.innerhtml = "<span>" & liste.list(Lig, Col) & "</span>"
                    TD.ID = Lig & ":" & Col: TD.classname = "tdover":
                    TD.FirstChild.Style.MarginLeft = "3px"
                    TD.onclick = Chr(34) & "clickTD(this.id);" & Chr(34)
                    TR.appendchild (TD)
                Next
                Table.appendchild (TR)
            Next
            code = "<div id=""foc"" style=""width:1px;height:1px;""></div>" & Replace(Table.outerhtml, "'", "")
        End With
        meta = vbCrLf & "<title>nolist</title>" & vbCrLf & "<meta http-equiv=""X-UA-Compatible"" content=""IE=10"">" & vbCrLf  '& "<!--meta charset=""utf-8""-->"
        lestyle = "<style> .tdover:hover{background-color:#81F7F3;}body{margin:0;} table{margin-top:-1px;margin-left:0;border-collapse:collapse;}</style>"
        lescript = "<script type=""text/javascript"">" & vbCrLf & "function clickTD(elemID){document.title= ""index:"" + elemID;document.getElementById(""foc"").focus();}" & vbCrLf & "</script>"
        With sweb
            .Move liste.Left, liste.Top, liste.Width, liste.Height
            liste.Visible = False: .Navigate "about:blank": .Silent = True
            Do: DoEvents: Loop While .ReadyState < 4
            code = Replace("<html>" & meta & "<head>" & lescript & "<style>" & lestyle & "</style></head><body>" & code & "</body></html>", ">", ">" & vbCrLf)
            .Document.write code
            .Refresh
            .SetFocus
        End With
    End Function
    'fonction de convertion point to prxel
    Function Pt_To_Px()
        With ActiveWindow.ActivePane
            Pt_To_Px = (.PointsToScreenPixelsY(33) - .PointsToScreenPixelsY(0)) / 33
        End With
    End Function
    'fonction de convertion couleur excel to couleur html
    Function coul_XL_to_coul_HTMLX(couleur)
        Dim str0 As String, str As String
        ' Debug.Print couleur
        'If couleur = 16777215 Then couleur = vbWhite
        str0 = Right("000000" & Hex(couleur), 6)
        str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
        coul_XL_to_coul_HTMLX = "#" & str & ""
    End Function
    '---------------------------
    Private Sub weblist_TitleChange(ByVal Text As String)
        If Text Like "*index*" Then
            listeb.Tag = Split(Text, "index:")(1)
            listeb.ListIndex = Split(Text, ":")(1)
        End If
    End Sub    'document.getElementById("colonneGauchePro").addEventListener("click", navigationPro);
    démo en image et fichier en piece jointe
    Nom : demo.gif
Affichages : 28
Taille : 743,8 Ko
    Fichiers attachés Fichiers attachés
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  6. #26
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Bonjour patricktoulon
    Tu ne changeras jamais ton habitude de lire en diagonale ?
    Rappel :
    Je souhaiterai savoir si il est possible de colorier le fond, ou la police, d'une valeur d'une listbox située à une certaine ligne et certaine colonne en fonction de sa valeur.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  7. #27
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    Bonjour unparia
    et je crois que je lui ai répondu clairement concernant la listbox je lui ai dis aussi et montré d'ailleurs que la listview avait la propriété"forecolor" applicable sur chaque cellules de la listview
    je lui ai dis aussi qu'il y avait d'autre possibilité avec les api que je lui ai déconseillé
    je lui ai dis aussi qu'il y avait d'autre astuce notamment les liens que lui a donné Philipe
    et que perso j'utiliserais un webbrowser en dynamique ce qui pouvait lui offrir un vrai sapin de noel
    c'est ce que j'ai fait
    je n'ai pas encore fini le principe ligne/colonne c'est une ébauche je l'ai bien précisé mais qui est fonctionnel
    je lui montre aussi que ma pseudolistbox offre la possibilité de sélectionner une cellule et non toute la ligne entière
    je lui montre aussi que le bouton (3/4 roulette souris)est actif ce qui peut être un avantage question pratique par rapport a la listbox qui elle ne l'a pas

    de bon matin comme ca un dimanche et en froid en plus hein!!?????
    ne lirais tu pas en diagonale toi aussi ?
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  8. #28
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    ne lirais tu pas en diagonale toi aussi ?
    Oh que non, paticktoulon. oh que non !
    Tout (et la seule chose) qu'il veut, c'est mettre en exergue une cellule paticulière (et une seule).
    Il ne veut pas "faire joli", mais tout simplement "montrer" cette cellule
    Ce qui est parfaitement réalisable (un salut au passage à Franck) y compris sans utilisation de fonctions de l'api de windows (celles nécessaires, Franck, au calcul de largeur et hauteur de texte) et sans javascript, mais au prix d'un alourdissement du code et de l'application et de l'ajout de deux composants natifs de VBA.

    Pour rester sérieux et sobre, maintenant :
    A JahExodus :
    - la mise en exergue de la totalité de la ligne de ta listbox contenant la cellule concernée est simple (le listindex met en surbrillance)
    - l'ajout d'un simple label (en bas de la listbox) te permettra d'y afficher ce que tu veux (ligne, colonne, valeur, titre de la colonne, comme tu l'entends ... ce qui t'est utile , quoi ...)

    Et tu feras ainsi l'économie d'un mécanisme non nécessaire.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  9. #29
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    relis le post 1 et regarde bien sa capture
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  10. #30
    Rédacteur

    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    janvier 2010
    Messages
    7 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : janvier 2010
    Messages : 7 200
    Points : 16 716
    Points
    16 716
    Billets dans le blog
    4

    Par défaut

    Bonjour Patrick,
    Au post #1, c'est clairement précisé
    Par exemple ici j'aimerais colorier la case Status en vert si le Status est "VALIDATED"
    Comme l'a écrit Unparia, c'est donc bien un élément qui se trouve à l'intersection de la ligne où se trouve la valeur VALIDATED de la colonne Status. C'est comme cela que je l'ai compris également.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mon tutoriel sur Les filtres avancés ou élaborés dans Excel
    Mes dernières contributions : Comment imbriquer une formule dans une formule à l'aide de la boîte de dialogue Insertion de fonction ? - Géolocalisation d'une adresse avec Excel et Google sans VBA

  11. #31
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    a ok
    alors peut être préfèrerait il celle ci:
    Nom : demo.gif
Affichages : 21
Taille : 462,1 Ko
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  12. #32
    Candidat au Club
    Homme Profil pro
    Inscrit en
    octobre 2013
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Egypte

    Informations forums :
    Inscription : octobre 2013
    Messages : 9
    Points : 4
    Points
    4

    Par défaut

    Bonjour patricktoulon
    Propriétaire d'une copie d'Office 2016
    Il a cité les codes suivants à mon profil
    en userform
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Dim cl As New listboxfuny
    Private Sub CommandButton1_Click()
        Dim couleurcolonne, couleurmot, mot
        couleurcolonne = Array(&HFF8080, &HC0C0&, &H80FF&, &HC0FFFF, &HC0C0FF, &HC0C0C0, &H8080FF, &HFF80FF, &HFF&)
        mot = Array("activated", "cadre", "toto")
        couleurmot = Array(vbRed, vbCyan)
        cl.substitut Me.ListBox1, couleurcolonne, mot, couleurmot
    End Sub
    en model
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    Sub listfun(liste, colcoul, mot, coulmot)
        Dim TR, TD, Lig, Col, Tablo, swidth, scR, lestyle, op
        swidth = Split(Replace(liste.ColumnWidths, " pt", ""), ";")
        op = Pt_To_Px
        'Set sweb = liste.Parent.Controls.Add("Shell.Explorer.2", "webctl", True)
        Set sweb = liste.Parent.Controls("webctl")
     
        With CreateObject("htmlfile")
            Set Table = .createelement("TABLE")
            .body.appendchild (Table)
     
            For Lig = 0 To liste.ListCount - 1
                Set TR = .createelement("TR")
                For Col = 0 To liste.ColumnCount - 1
                    Set TD = .createelement("TD")
                    With TD.Style: .Width = Round((swidth(Col) * op)) & "px": .Border = "1px solid " & coul_XL_to_coul_HTMLX(vbBlack)
                        .backgroundcolor = coul_XL_to_coul_HTMLX(colcoul(Col))
                    End With
                    TD.innertext = liste.list(Lig, Col): TD.ID = Lig & ":" & Col    ':TD.classname = "tdover":
                    TD.onclick = Chr(34) & "clickTD(this.id);" & Chr(34)
                    TR.appendchild (TD)
                Next
                Table.appendchild (TR)
            Next
     
            code = Replace(Table.outerhtml, "'", "")
     
        End With
     
        meta = vbCrLf & "<title>nolist</title>" & vbCrLf & "<meta http-equiv=""X-UA-Compatible"" content=""IE=10"">" & vbCrLf  '& "<!--meta charset=""utf-8""-->"
     
        lestyle = "<style> .tdover:hover{background-color:#81F7F3;}body{margin:-2px} table{margin:-1px;border-collapse:collapse;}</style>"
     
        'lescript = "<script type=""text/javascript"">" & vbCrLf & "function clickTD(elemID){alert(elemID);}" & vbCrLf & "</script>"
        lescript = "<script type=""text/javascript"">" & vbCrLf & "function clickTD(elemID){document.title= ""index:"" + elemID;}" & vbCrLf & "</script>"
     
     
        With sweb
            .Move liste.Left, liste.Top, liste.Width, liste.Height
            liste.Visible = False: .Navigate "about:blank": .Silent = True
            Do: DoEvents: Loop While .ReadyState < 4
            code = Replace("<html>" & meta & "<head>" & lescript & "<style>" & lestyle & "</style></head><body>" & code & "</body></html>", ">", ">" & vbCrLf)
     
            .Document.write code
            .Refresh
            .SetFocus
     
        End With
    End Sub
    Function Pt_To_Px()
        With ActiveWindow.ActivePane
            Pt_To_Px = (.PointsToScreenPixelsY(100) - .PointsToScreenPixelsY(0)) / 100
        End With
    End Function
    Function coul_XL_to_coul_HTMLX(couleur)
        Dim str0 As String, str As String
        ' Debug.Print couleur
        'If couleur = 16777215 Then couleur = vbWhite
        str0 = Right("000000" & Hex(couleur), 6)
        str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
        coul_XL_to_coul_HTMLX = "#" & str & ""
    End Function
    '---------------------------
    'document.getElementById("colonneGauchePro").addEventListener("click", navigationPro);
    en class
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    Option Explicit
    Public WithEvents weblist As WebBrowser
    Public WithEvents formm As UserForm
    Public WithEvents listeb As MSForms.ListBox
     
    Private usf As New listboxfuny
     
    Function substitut(liste, colcoul, mot, coulmot)
     
        Dim TR, TD, Lig, Col, swidth, scR, op, sweb, Table, code, meta, lescript, lestyle
        If liste.ColumnWidths <> "" Then swidth = Split(Replace(liste.ColumnWidths, " pt", ""), ";")
        op = Pt_To_Px
        Set sweb = liste.Parent.Controls.Add("Shell.Explorer.2", "webctl", True)
        Set usf.formm = liste.Parent: Set usf.weblist = sweb: Set usf.listeb = liste
        With CreateObject("htmlfile")
            Set Table = .createelement("TABLE")
            Table.Style.FontSize = liste.Font.Size * op + 2: Table.Style.Width = "100%"
            .body.appendchild (Table)
     
            For Lig = 0 To liste.ListCount - 1
                Set TR = .createelement("TR")
                For Col = 0 To liste.ColumnCount - 1
                    Set TD = .createelement("TD")
                    With TD.Style:
                        If liste.ColumnWidths <> "" Then .Width = Round((swidth(Col) * op)) & "px":
                        .Border = "1px solid " & coul_XL_to_coul_HTMLX(&H808080)
                        .backgroundcolor = coul_XL_to_coul_HTMLX(colcoul(Col))
                    End With
                    If liste.list(Lig, Col) <> "" Then TD.innerhtml = "<span>" & liste.list(Lig, Col) & "</span>"
                    TD.ID = Lig & ":" & Col: TD.classname = "tdover":
                    TD.FirstChild.Style.MarginLeft = "3px"
                    TD.onclick = Chr(34) & "clickTD(this.id);" & Chr(34)
                    TR.appendchild (TD)
                Next
                Table.appendchild (TR)
            Next
            code = "<div id=""foc"" style=""width:1px;height:1px;""></div>" & Replace(Table.outerhtml, "'", "")
        End With
        meta = vbCrLf & "<title>nolist</title>" & vbCrLf & "<meta http-equiv=""X-UA-Compatible"" content=""IE=10"">" & vbCrLf  '& "<!--meta charset=""utf-8""-->"
        lestyle = "<style> .tdover:hover{background-color:#81F7F3;}body{margin:0;} table{margin-top:-1px;margin-left:0;border-collapse:collapse;}</style>"
        lescript = "<script type=""text/javascript"">" & vbCrLf & "function clickTD(elemID){document.title= ""index:"" + elemID;document.getElementById(""foc"").focus();}" & vbCrLf & "</script>"
        With sweb
            .Move liste.Left, liste.Top, liste.Width, liste.Height
            liste.Visible = False: .Navigate "about:blank": .Silent = True
            Do: DoEvents: Loop While .ReadyState < 4
            code = Replace("<html>" & meta & "<head>" & lescript & "<style>" & lestyle & "</style></head><body>" & code & "</body></html>", ">", ">" & vbCrLf)
     
            .Document.write code
            .Refresh
            .SetFocus
        End With
    End Function
    'fonction de convertion point to prxel
    Function Pt_To_Px()
        With ActiveWindow.ActivePane
            Pt_To_Px = (.PointsToScreenPixelsY(33) - .PointsToScreenPixelsY(0)) / 33
        End With
    End Function
    'fonction de convertion couleur excel to couleur html
    Function coul_XL_to_coul_HTMLX(couleur)
        Dim str0 As String, str As String
        ' Debug.Print couleur
        'If couleur = 16777215 Then couleur = vbWhite
        str0 = Right("000000" & Hex(couleur), 6)
        str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
        coul_XL_to_coul_HTMLX = "#" & str & ""
    End Function
    '---------------------------
    Private Sub weblist_TitleChange(ByVal Text As String)
     
        If Text Like "*index*" Then
            listeb.Tag = Split(Text, "index:")(1)
            listeb.ListIndex = Split(Text, ":")(1)
     
        End If
    End Sub    'document.getElementById("colonneGauchePro").addEventListener("click", navigationPro);
    Je listBox le code pour appeler des données
    Je tiens à souligner l'apparition de lignes et de colonnes
    Mais il ne fonctionne pas correctement
    ==================
    Le message d'erreur ici
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Public WithEvents weblist As WebBrowser

  13. #33
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Je veux bien que l'on s'amuse à aller d'égarements en égarements, de trucs en trucs, etc ...
    Je rappelle deux petites choses :
    1) JahExodus est un étudiant
    2) il nous parle d'un "demandeur". Ce dernier est très vraisemblablement son tuteur
    3) il est plus que vraisemblable (et je le comprends ô combien) que ce "demandeur" ne souhaite et n'admettra aucune dépendance, que cette dernière soit à la présence et disponibilité de mscomctl.ocx ou qu'elle le soit à l'utilisation de scripts ou langages tiers (il les a peut-être de surcroît inhibés ).
    Pijaku a exposé à juste titre l'idée d'un label "par-dessus". J'ai appuyé cette idée (me relire) en précisant qu'il fallait alors utiliser un second contrôle supplémentaire, tout en précisant que même cela s'écartait quelque peu d'une certaine rigueur et efficacité.

    Le "demandeur" attend probablement plus volontiers une démonstration d'effort d'efficacité et de convivialité réelles exprimées autrement. Par l'utilisation, par exemple d'une combobox qui, elle, apporterait un réel "plus" (celui d'une recherche semi-automatique à partir de la zone d'édition, dans une colonne autre que la 1ère).
    Pour résumer : nous avons là un étudiant. Gardons-nous de l'encourager à utiliser ce que son tuteur jugera inapproprié, s'il vous plait.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  14. #34
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    re
    Pijaku a exposé à juste titre l'idée d'un label "par-dessus". J'ai appuyé cette idée (me relire) en précisant qu'il fallait alors utiliser un second contrôle supplémentaire, tout en précisant que même cela s'écartait quelque peu d'une certaine rigueur et efficacité.
    c'est beau les rêves mais ca n'est que ca
    tu peux mettre autant de control que tu veux dessus il ne seront pas visible j'avais testé cette idée il y a bien longtemps
    absolument rien ne peut être affiché par dessus une combo ou listbox
    Nom : demo.gif
Affichages : 18
Taille : 620,1 Ko
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  15. #35
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Tu lis toujours trop vite, patricktoulon
    Relis donc :
    Ce qui est parfaitement réalisable (un salut au passage à Franck) y compris sans utilisation de fonctions de l'api de windows (celles nécessaires, Franck, au calcul de largeur et hauteur de texte) et sans javascript, mais au prix d'un alourdissement du code et de l'application et de l'ajout de deux composants natifs de VBA.
    J'ai appuyé cette idée (me relire) en précisant qu'il fallait alors utiliser un second contrôle supplémentaire
    Et nous savons le faire (Franck et moi). Et sans "rêver" ...

    Surtout pour si simple, comparé à du plus complexe que nous savons mettre en oeuvre également (nous ne l'avons fait que pour nous divertir, car sans aucun intérêt réel).
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  16. #36
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Allez ... pour que les Toulonnais ne soient pas à la traîne -->> Un indice --->>
    Le second contrôle est un Frame
    Tu ne "vois" toujours pas ?
    Cet aspect-là est vraiment le plus simple. C'est le reste, qui demande calculs, précision et adresse ...
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  17. #37
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    re
    la fausse combo ou liste boxe avec une frame dynamique déjà fait il me semble même que je l'avais mis dans les contribs
    pour le lien de Philippe concernant la combobox j'utilise déjà ce principe dans ma fausse classe bouton dans les contribs
    je vais en refaire une

    par contre tu disais que franck a trouver le font to pixel sans apis ca oui ce m'intéresse
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  18. #38
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Ah ... Tu t'es réveillé. ais pas encore suffisamment -->>
    par contre tu disais que franck a trouver le font to pixel sans apis ca oui ce m'intéresse
    Où ai-je dit cela (encore une lecture en diagonale ?) ?
    J'ai dit :
    y compris sans utilisation de fonctions de l'api de windows (celles nécessaires, Franck, au calcul de largeur et hauteur de texte)
    rien à voir avec "font to pixel" (qui voudrait dire quoi, d'ailleurs ?) !!!
    Ces dimensions graphiques sont obtenues par exemple sous VB6 par l'utilisation des méthodes TextWidth et Textheight, inexistantes sous VBA/Excel. "Quelqu'un" a déposé "quelque part" de quoi (à l'aide de fonctions de l'Api de Windows) avoir sous VBA ce qu'offre VB6 en matière de conversions d'unités graphiques, etc ...
    Que veux-tu savoir exactement ? Calculer très exactement la hauteur graphique et la largeur graphique d'un texte sans fonctions de l'Api ? C'est cela, que je disais à Franck (qui, lui, utilise jusqu'à présent la seule la conversion par api) . Si c'est cela, dis-le ...
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  19. #39
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 923
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 76
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : avril 2016
    Messages : 2 923
    Points : 5 028
    Points
    5 028

    Par défaut

    Allez (je vais dormir) ------>
    Petite démo un peu bâclée ----->
    sur un userform : un label Label1 et un commandbutton
    ce code au click du bouton de commande
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
      With Label1
        .AutoSize = True
        .WordWrap = False
        .BorderStyle = 0
        .Caption = String(20, "Si les Toulonnais Prenaient le temps de lire, Les choses seraient plus simples")
        .FontName = ListBox1.FontName
        .FontSize = ListBox1.FontSize
        .FontBold = ListBox1.FontBold
        .FontItalic = ListBox1.FontItalic
        .FontStrikethru = ListBox1.FontStrikethru
        .FontUnderline = ListBox1.FontUnderline
        .FontWeight = ListBox1.FontWeight
        h = .Height
        l = .Width / Len(.Caption)
        .Visible = False
      End With
      For i = 1 To 300
        ListBox1.AddItem "coucou"
      Next
      nbart = ListBox1.Height / h
      MsgBox "le nombre d'articles ""visibles"" dans la listbox est = " & nbart
    Ici, cette démo calcule la hauteur graphique occupée par chaque article de la listbox et en déduit le nombre total d'articles affichables à la fois.
    Tu peux faire varier tout ce que tu veux (hauteur de la listbox, taille de la police, etc ... Le calcul sera toujours exact.

    Les dimensions sont toujours (sous VB6 également, d'ailleurs) calculées en unités logiques de l'échelle en cours. Donc en points sous VBA/Excel.

    Je te laisse maintenant découvrir seul (les Toulonnais devraient avoir des idées) à quoi peut servir l'utilisation de la variable l
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro). Ne m'en proposez donc pas.

  20. #40
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 063
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 9 063
    Points : 14 802
    Points
    14 802
    Billets dans le blog
    1

    Par défaut re

    re
    a oui bien vu
    il existe la même astuce avec les cellule et autofit mais moins précise
    j'obtiens 301 points pour le fontwidth pour le string(20,....) j'ai des doutes je comparerais demain avec mon logiciel webdisigner qui est une excellente référence
    par contre pour le height ca c'est excellent
    bravo a franck alors
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

Discussions similaires

  1. Enregistrer donner Textbox dans une case précise sur excel
    Par nicolas591 dans le forum VB 6 et antérieur
    Réponses: 1
    Dernier message: 16/01/2012, 00h17
  2. [C#] Acceder à une case précise d'un DataTable
    Par Johann7751 dans le forum C#
    Réponses: 2
    Dernier message: 15/06/2009, 18h28
  3. Réponses: 9
    Dernier message: 18/02/2008, 11h25
  4. Réponses: 3
    Dernier message: 17/01/2008, 12h51
  5. [JXTable] Sélection d'une case précise
    Par doons dans le forum AWT/SWING
    Réponses: 1
    Dernier message: 11/01/2008, 11h43

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo