1. #81
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    oui ca j'avais plus ou moins compris mais même avec un coefficient ca ne marche pas

    j'ai tester différentes solution avec différentes propriétés
    activewindow
    activepane
    application
    etc...
    aucune combinaison de 2 et plus ne matchent
    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. #82
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    je te montre cela demain après-midi (je vais au dodo, maintenant).
    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.

  3. #83
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    Je commençais à m'y mettre de bon matin lorsque, entamant mes calculs, je me suis d'un seul coup rappelé que je t'en avais dit l'essentiel il y a déjà .... 12 jours !
    Et que tu avais appelé cela : ma "petite fonction" !!!
    Ah bon, "petite foonction" ? Hé bien -->> je vais boire mon "petit café" et reviens en l'appliquant, cette "petite fonction"

    EDIT : et je viens de voir que j'étais même allé, un peu plus loin (il y a 9 jours), à préciser :

    Et crois-tu que je ne t'ai pas dit (presque totalement) sans utiliser l'api de windows ?
    C'est ce que tu as appelé ma "petite fonction", qui te le permet.
    Je t'ai même dit plus haut (relis-moi) qu'il fallait ensuite convertir pour le curseur, mais qu'il n'était pas nécessaire de convertir pour simplement placer un userform .

    Et ces coordonnées ne dépendent, elles, en aucun cas du zoom. Elles restent fixes. Seul le "miroir" résultant du zoom voit ses dimensions, etc ... transformées à l'intérieur de cette fenêtre (qui, elle, est fixe)
    Elles dépendent par contre de ce que l'on affiche ou non les titres (de lignes et de colonnes), ainsi que des coordonnées de l'Application et de celles de la grille au sein de la fenêtre active
    Hééééé... ouais ....
    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.

  4. #84
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    je suis remonter a ta capture détaillant les parties

    bref sans api non quoi?
    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

  5. #85
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    bref sans api non quoi?
    Sans AUCUNE fonction de l'Api de Windows ...
    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.

  6. #86
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    sans parler du mode modeless qui change tout
    teste ca avec 0 ou pas après show
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    UserForm1.Show
    UserForm1.Left = CDbl([D3].Left + AA.PointsToScreenPixelsX(0)) 'AA.PointsToScreenPixelsX([D3].Left) - AA.PointsToScreenPixelsX(0) / pttpx
    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

  7. #87
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    Bon ...
    Je vais te mettre sur la voie de l'essentiel et te laisser faire des calculs à partir de ce code qui, à cette étape, ne traite pas le zoom (donc à 100%) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Private Sub CommandButton1_Click()
      bh = IIf(ActiveWindow.DisplayHeadings, UserForm1.Height - UserForm1.InsideHeight - 6, 2)
      bl = IIf(ActiveWindow.DisplayHeadings, bh - 1, 0)
      Set cible = Range("E10")
      h = Application.Top + (Application.Height - Application.UsableHeight) + ActiveWindow.Top
      l = Application.Left + (Application.Width - Application.UsableWidth) + ActiveWindow.Left
      UserForm1.Show
      UserForm1.Top = (h + (cible.Top) + bh - Cells(ActiveWindow.ScrollRow, 1).Top) 
      UserForm1.Left = l + (cible.Left) + bl - Cells(1, ActiveWindow.ScrollColumn).Left
    End Sub
    1) J'ai à cette étape traité tout le reste (ruban, barre des formules, fenêtres flottantes, barre des titres)
    regarde bien la première ligne :
    a) le 6 et le 2 ne sont pas arbitraires (ils sont toujours vrais et correspondent à quelque-chose de très précis. Tu devrais trouver à quoi, si tu observes bien)
    b) j'aurais pu éviter d'utiliser la fenêtre du userform (on peut parvenir autrement au calcul de bh et de bl, mais au prix d'un très bref clignotement de l'écran)
    2) reste à faire quelques calculs arithmétiques que je souhaite te voir faire (ou tenter de le faire) seul dans un premier temps.
    Pourquoi est-ce que j'ai choisi de te laisser d'abord seul traiter cet aspect ? --->> tout simplement parce-que c'est là très nettement le meilleur moyen de te faire bien appréhender ce que sont :
    - les différentes fenêtres de l'application Excel
    - le zoom et à quoi il s'applique
    Pour t'y aider, je t'invite à bien regarder et re-regarder l'une des captures d'écran que j'ai affichées dans cette discussion d'abord, puis la dernière capture (qui met en exergue le principe "miroir et homothétie" utilisé par Excel.
    Prends ton temps. Ne te précipite pas.
    Tu devrais y arriver sans mon aide si tu sais :
    - observer
    - prendre ton temps (surtout)
    - calculer

    Bons calculs (il pleut et ce sera là un bon divertissement).
    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.

  8. #88
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    Ah oui. J'ai oublié de rajouter ce qu'il faut pour le cas où application en plein écran --->>
    Ajouter cette ligne de code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     If Application.DisplayFullScreen Then bh = bh + bh - 2
    Juste APRES (APRES, hein ... pas avant) celle qui dit
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    bl = IIf(ActiveWindow.DisplayHeadings, bh - 1, 0)
    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. #89
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    bon ben voila ma version
    il y a une toute petite divergence avec ta version
    j'utilse le width/insidewidth pour le top
    et height/insideheight pour le left
    pour le left on pourrait l'admettre la colonne des chiffre peut mesurer le coefficiant mais pour le top j'ai du mal
    en tout cas ca marche
    tu veux bien essayer
    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
    Sub test3()
    'devrait correspondre a ton -6
    ecc = (UserForm1.Width - UserForm1.InsideWidth)
     
    'devrait correspondre a la hauteur d'une caption soit une display barre(heading/formulas/etc....y compris la largeur de la colonne des N°colonne a gauche )
    ecc2 = (UserForm1.Height - UserForm1.InsideHeight)
     
    ttop = (Application.Top + 1 + Application.Height - Application.UsableHeight) - (ecc) + [d3].Top - Cells(ActiveWindow.ScrollRow, 1).Top
     
    lleft = (Application.Left + 1 + Application.Width - Application.UsableWidth) + (ecc2) + [d3].Left - -Cells(ActiveWindow.ScrollColumn, 1).Left
     
    ttop = ttop * (ActiveWindow.Zoom / 100)
     
    lleft = lleft * (ActiveWindow.Zoom / 100)
     
    UserForm1.Show
    UserForm1.Top = ttop
    UserForm1.Left = lleft
    End Sub
    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. #90
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    en tout cas ca marche
    tu veux bien essayer
    Ben non ! (et j'ai quand-même essayé, bien que sachant que non).
    Je te l'ai dit et le répète : PRENDS TON TEMPS

    Et en passant (mais ce n'est pas la seule erreur) : comment fais-tu pour connaître le nouveau coût de revient d'une tasse de café lorsque le prix du seul sucre a augmenté de 10 % sans connaître (et séparer dans tes calculs) :
    - le coût originel (avant augmentation) de la dose de sucre mise dans une tasse
    - le coût de tous les autres ingrédients mis dans la tasse)
    - le coût de tous les autres frais (électricité, taxes, salaires, etc ...)

    OK ? --->> PRENDS DONC TON TEMPS sur ces bases. CESSE DE TE PRECIPITER (sinon : je te laisse 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.

  11. #91
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    alors j'y comprends plus rien
    ton calcul tel que tu me l'a donné me donne au moins 11 points de marge d'erreur soit e10 comme cible et se retrouve en d9 a l'intérieur
    et j'ai le zoom a 100%
    on est tellement loin du (même résultat) l'un de l'autre
    Nom : demo.gif
Affichages : 57
Taille : 678,8 Ko
    ou alors il y a un parametre écran ou autre que l'on ignore qui est diffèrent de toit a moi ce qui fait que le calcul est different
    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. #92
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    en effet dans mon exemple je n'ai pas pris en compte le active window flottant (le classeur ne remplit pas toute l'application)
    voila je le prends en compte le flottant
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Sub test8()
        Dim ecc#, ecc2#, ttop#, lleft#, zz#, ApP As Object, ActW As Object, usf As Object
        Set ApP = Application: Set ActW = ActiveWindow: Set usf = UserForm1
        With usf: ecc = (.Width - .InsideWidth): ecc2 = (.Height - .InsideHeight): End With
        zz = (ActW.Zoom / 100)
        With ApP
            ttop = (((.Top + 1 + .Height - .UsableHeight) + (actW.Top + ecc2)) - (ecc) + [E10].Top - Cells(ActW.ScrollRow, 1).Top) * zz
            lleft = (((.Left + 1 + .Width - .UsableWidth) + (actW.Left + ecc)) + (ecc2) + [E10].Left - -Cells(ActW.ScrollColumn, 1).Left) * zz
        End With
       With UserForm1: .Show: .Top = ttop: .Left = lleft: End With
    End Sub
    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

  13. #93
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    Excuse-moi, mais ... je t'abandonne.
    Bonne chance.
    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. #94
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    merci
    maintenant que j'ai compris ton calcul je te le donne avec "PointsToScreenPixelsX"
    car en effet cette fonction fait les ajout des partie toute seule sauf les épaisseurs de cadre (width-insidewidth)
    on a plus a se préoccuper du top application,activewindow.top ,etc......
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Sub test2()
        Dim  pttopx#, ttop#, lleft#
        With ActiveWindow.ActivePane
            pttopx = (.PointsToScreenPixelsX(33) - .PointsToScreenPixelsX(0)) / 33
            ecc = (UserForm1.Width - UserForm1.InsideWidth)
            lleft = (.PointsToScreenPixelsX([d3].Left) + (ecc * pttopx)) / pttopx
            ttop = (.PointsToScreenPixelsY([d3].Top) + (ecc * pttopx)) / pttopx
        End With
        With UserForm1: .Show 0: .Left = lleft: .Top = ttop: End With
    End Sub
    si tu repasse par la
    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. #95
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    si tu repasse par la
    oui ... je lis ... je lis ... (et toi tu ne lis pas, à commencer par l'exemple du sucre dans la tasse de café).
    Te rends-tu compte au moins de ce que tu fais-là ?
    Je vais te le dire :
    tu utilises des calculs pour extraire en nouvelle échelle d'unités des coordonnées que tu ramènes ensuite dans l'échelle originelle.
    Ah ouais -->> tu auras en effet ainsi les coordonnées à l'écran (par rapport à l'ensemble de la fenêtre Application) , dans la bonne échelle d'unités, du coin supérieur gauche de la cellule traitée, sans facteur de zoom.
    Et ? tu comptes appliquer quel coefficient/zoom à ces coordonnées-là ?
    Réponds à cette simple question toute bête (sans le moindre code supplémentaire "jeté" ici en "test") ?
    Mais ne réponds pas avant d'avoir lu et relu tout ce que j'ai tenté et retenté et reretenté de t'exposer, des captures d'écran que j'ai montrées, etc ... Re-relis également l'histoire du sucre et du café.

    L'extraction de ces coordonnées-là ne t'apportera RIEN en matière de correction du fait du zoom.
    Mais si tu continues à vouloir faire des ronds dans l'eau, ma foi ... continue donc ...
    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. #96
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    voila le projet abouti
    le nom des macros parle lui même
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub TestUserformDansPlage()
        r = RectanGleRange(UserForm1, [B3:F12])
        With UserForm1: .Show 0: .Left = r(0): .Top = r(1): .Width = r(2): .Height = r(3): End With
    End Sub
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub TestUserformtopleftcell()
        r = RectanGleRange(UserForm1, [B3])
        With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
    End Sub
    et la fonction RectanGleRange
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Function RectanGleRange(usf, rng)
        Dim pttopx#, ttop#, lleft#, ecc#, Hheight#, Wwidth#
        With ActiveWindow.ActivePane
            pttopx = (.PointsToScreenPixelsX(3) - .PointsToScreenPixelsX(0)) / 3    'coefficient multiplicateur pixel
            ecc = (usf.Width - usf.InsideWidth) * pttopx    'epaisseur du cadre*2
            lleft = (.PointsToScreenPixelsX(rng.Left) + ecc) / pttopx
            ttop = (.PointsToScreenPixelsY(rng.Top) + ecc - pttopx) / pttopx
            Wwidth = IIf(rng.Columns.Count > 1, rng.Width - ecc - pttopx, usf.Width)
            Hheight = IIf(rng.Rows.Count > 1, rng.Height - ecc - pttopx, usf.Height)
        End With
        RectanGleRange = Array(lleft, ttop, Wwidth, Hheight)
    End Function

    démo
    Nom : demo.gif
Affichages : 55
Taille : 851,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

  17. #97
    Candidat au Club
    Homme Profil pro
    Technicien réseau
    Inscrit en
    mars 2016
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 72
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Technicien réseau

    Informations forums :
    Inscription : mars 2016
    Messages : 10
    Points : 4
    Points
    4

    Par défaut

    Bonjour,
    Il est évident que mon usine à gaz me déçois car je comptais trouver dans le net seulement 2 lignes (la déclaration d'une API et sa commande).
    Juste une petite remarque, le 15 mai tu me parles de la fonction RangeFromPoint et de boucles mais mon premier module ne tourne qu'avec ces deux éléments.
    Merci encore pour cette étude

    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
     
           Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
           Dim PosXRow, PosYCol, N_PosXRow, N_PosYCol
    '@@@=== DEB TEST ====
     Sub TEST():  N_PosXRow = 0: N_PosYCol = 0: PosXRow = 0: PosYCol = 0
                                 SelCelROW = 10: SelCelCOL = 5 '<<<=====  CIBLE
                           Cells(SelCelROW, SelCelCOL).Select
          Positionner_CURSEUR_CELL SelCelROW, SelCelCOL: End Sub '==== FIN TEST ===@@@
     
    Sub Positionner_CURSEUR_CELL(SelCelROW, SelCelCOL): ScreenWidth = 1600: ScreenHeight = 900
                            PosYColRD = (Application.Top * 1.33) + (ActiveWindow.Top * 1.33)
     For N_PosYCol = PosYColRD + 100 To ScreenHeight - 20:            CelRD = ""
      On Error Resume Next: CelRD = ActiveWindow.RangeFromPoint(200, N_PosYCol).Address
                    If Trim(CelRD) = "" Then GoTo N_Row
                    If Left(CelRD, 1) = "$" Then CelRD = Mid(CelRD, 2)
               Pos$ = InStr(CelRD, "$"):  If Pos$ > 1 Then Row = Val(Mid(CelRD, Pos + 1))
            If SelCelROW = Row Then
               N_PosYCol = N_PosYCol + (Range(CelRD).RowHeight * 1.33) - 7: PosYCol = N_PosYCol
                                                            GoTo PosYColTrouvee_ChercherPosXRow
            End If
    N_Row:
     Next N_PosYCol
    '-------------------------------------------------------------------------------------
    PosYColTrouvee_ChercherPosXRow:
                            PosXRowRD = (Application.Left * 1.33) + (ActiveWindow.Left * 1.33)
     For N_PosXRow = PosXRowRD + 50 To ScreenWidth - (PosXRowRD + 1): CelRD = ""
      On Error Resume Next: CelRD = ActiveWindow.RangeFromPoint(N_PosXRow, N_PosYCol).Address
                    If Trim(CelRD) = "" Then GoTo N_Col
                           CoL = Range(CelRD & 1).Column: If CoL < 1 Then GoTo N_Col
            If SelCelCOL = CoL Then
               N_PosXRow = N_PosXRow + 10: PosXRow = N_PosXRow: SetCursorPos PosXRow, PosYCol: End
            End If
    N_Col:
     Next N_PosXRow
    End Sub

  18. #98
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    si tu veux
    ce que j'ai voulu dire avec range from point c'est que puisque tu boucle sur un chiffre avec les api autant s'en passer

    tu prend par exemple
    x=application.left +activewindows.left+au hasard 100

    et tu boucle sur y step 1 en testant rangefrompoint(x,y)
    et tu fait pareil pour y après

    au pire la boucle dure 1pixel*ta résolution écran large et inversement pour le top
    autant dire immédiat

    mais!!!! avec ma méthode avec pointstoscreenpixels (x/y)sur tout les pcs que j'ai pu essayer donne un résultat nickel
    avec ou sans displayheading, ruban, activewindow flottante ou pas ,application fenêtrée placée au hasard , zoom ou pas zoom, affichage Windows amélioré ou pas

    et elle te donne même le rectangle en points d'une plage de cellule[

    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
    Sub TestUserformtopleftcell()
        r = RectanGleRange(UserForm1, [b3])
        With UserForm1: .Show 0: .Left = r(0): .Top = r(1): End With
    End Sub
     
    Function RectanGleRange(usf, rng)
        Dim pttopx#, ttop#, lleft#, ecc#, Hheight#, Wwidth#, zz#
        With ActiveWindow
            pttopx = (.ActivePane.PointsToScreenPixelsX(3) - .ActivePane.PointsToScreenPixelsX(0)) / 3    'coefficient multiplicateur pixel
            zz = (.Zoom / 100)
            ecc = ((usf.Width - usf.InsideWidth) / 2) * pttopx  'epaisseur du cadre
            ecc2 = ((usf.Height - usf.InsideHeight) / 2)   'epaisseur du cadre
            lleft = ((.ActivePane.PointsToScreenPixelsX(rng.Left) / pttopx) * zz) + (ecc)
            ttop = ((.ActivePane.PointsToScreenPixelsY(rng.Top) / pttopx) * zz) + (ecc)
            Wwidth = IIf(rng.Columns.Count > 1, (rng.Width * zz) - (ecc) - pttopx - 2, usf.Width)
            Hheight = IIf(rng.Rows.Count > 1, (rng.Height * zz) - (ecc) - pttopx - 2, usf.Height)
        End With
        RectanGleRange = Array(lleft, ttop, Wwidth, Hheight)
    End Function
    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

  19. #99
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    avril 2016
    Messages
    2 975
    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 975
    Points : 5 117
    Points
    5 117

    Par défaut

    Tu y es presque, Patricktoulon. Presque, car décalages (selon les cas) d'environ 3 pixels tant en hauteur qu'en largeur.
    La cause ? je te l'ai dite plus haut :
    1) seule une partie de l'écran subit le zoom
    2) ton code ne "zoome" pas les bordures.
    Mais c'est déjà beaucoup mieux que ce que tu avais fait avant.
    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. #100
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    9 128
    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 128
    Points : 14 872
    Points
    14 872
    Billets dans le blog
    1

    Par défaut re

    oui chez moi c'est inperceptible
    en supprimant l'application des deux zomm a ecc on gagne encore des milimilimillieme de précision et appliquant
    le coefficient sans le(zoom window(affichage résolution 125% ) )donc 1.3333333333 soit 4/3 qui est une constante
    j'
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    Function RectanGleRange(usf, rng)
        Dim pttopx#, ttop#, lleft#, ecc#, Hheight#, Wwidth#, zz#
        With ActiveWindow
            pttopx = (.ActivePane.PointsToScreenPixelsX(3) - .ActivePane.PointsToScreenPixelsX(0)) / 3    'coefficient multiplicateur pixel
            zz = (.Zoom / 100)
            ecc = (usf.Width - usf.InsideWidth) * (4 / 3) 'epaisseur du cadre
            ecc2 = ((usf.Height - usf.InsideHeight) / 2)   'epaisseur du cadre
            lleft = ((.ActivePane.PointsToScreenPixelsX(rng.Left) / pttopx) * zz) + (ecc)
            ttop = ((.ActivePane.PointsToScreenPixelsY(rng.Top) / pttopx) * zz) + (ecc)
            Wwidth = IIf(rng.Columns.Count > 1, (rng.Width * zz) - (ecc) - pttopx - 2, usf.Width)
            Hheight = IIf(rng.Rows.Count > 1, (rng.Height * zz) - (ecc) - pttopx - 2, usf.Height)
        End With
        RectanGleRange = Array(lleft, ttop, Wwidth, Hheight)
    End Function
    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. se positionner sur une cellule
    Par titemireille dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 28/01/2008, 19h07
  2. cliquer sur une cellule qui m'ouvre un autre fichier excel
    Par booskap dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 17/08/2007, 11h08
  3. [VBA-Excel] DblClick sur une cellule
    Par marsupilami34 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 04/01/2007, 10h51
  4. [VBA-Excel]Supprimer une colonne entiere basee sur une cellule
    Par Tartenpion dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 05/10/2006, 22h08
  5. [Vba-Excel] Récupérer événement sur une cellule
    Par steps5ive dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 26/04/2006, 20h27

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