1. #1
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 552
    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 : 10 552
    Points : 16 756
    Points
    16 756
    Billets dans le blog
    1

    Par défaut utiliataire de capture d'ecran avec selection dynamique de la partie d'ecran avec (userform)

    Bonjour a tous
    je vous propose un exemplaire simplifier de mon utilitaire de capture

    le principe
    j'ouvre un userform sur le quel j'ai enlevé la caption et rendu resizable avec la souris

    il est rendu translucide pour voir ce qu'il y a en dessous

    1. avec la souris rester appuyé et déplacer le userform a son grés
    2. avec le clic droit capturer tout simplement
    3. le double click le ferme pour annuler la capture
    4. redimensionner en restant appuyé sur les bords comme les fenêtres classiques


    cet userform peut très bien être logé dans un xla(m)


    méthode d'appel

    avec boite de dialogue pour choisir le chemin
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Private Sub CommandButton1_Click()
    With captur: .Show 0: .Tag = 1: End With
    End Sub
    enregistre directement sur le burau
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Private Sub CommandButton2_Click()
    captur.Show 0
    End Sub
    code dans l'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
    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
    'application des modification
    Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    'trouver le handle
    Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'on redessine la barre sinon elle se retrouve en bas de l'userform
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    'capturer le handle et pouvoir le deplacer
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function ReleaseCapture Lib "user32" () As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
    'api pour capture basic
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Dim handle
    Dim handleApp
    Dim otherhandle
    Dim LW
    Dim plan
    Private Sub UserForm_Activate()
        Me.BackColor = vbRed
        handle = fwa(vbNullString, Me.Caption)
        handleApp = Application.hwnd
        SetParent handle, GetDesktopWindow()
        SetWindowPos handleApp, 1, 0&, 0&, 0&, 0&, (&H10 Or &H40 Or &H1 Or &H2)     'force l'userform au  premier plan
        SetWindowLongA handle, -16, &H140F0101: DrawMenuBar handle    ' sans caption cadre epais coin  arrondi et elastique
        SetWindowLongA handle, -20, &H80109    'Rajoute l'attribut transparent à la fenêtre.
        SetLayeredWindowAttributes handle, 0, 60, &H2    'application de la transparence de 0 a 255 ici 60
        LW = Round(Me.Height - Me.InsideHeight)    'recupération de l epaisseur  du cadre
        SetWindowPos handle, -1, 0&, 0&, 0&, 0&, (&H1 Or &H2)    'force l'userform au  premier plan
    End Sub
     
    Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
      Unload Me
    End Sub
    Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Dim hPicAvail, fname, chemin$
        If Button = 1 Then
            ReleaseCapture
            SendMessage handle, &HA1, 2, 0&
        Else
            With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
        SetWindowLongA handle, -16, &H94080080: SetWindowLongA handle, -20, &H0: DrawMenuBar handle   ' sans caption
        SetWindowLongA handle, -20, &H80109
        SetLayeredWindowAttributes handle, 0, 0, &H2
        Me.Move Me.Left + (LW / 2), Me.Top + (LW / 2), Me.Width - (LW), Me.Height - (LW)
          SetWindowPos handle, -1, 0&, 0&, 0&, 0&, (&H1 Or &H2)    'force l'userform au  premier plan
        'SetParent handle, GetDesktopWindow()
         keybd_event &H2C, 1, 0, 0: keybd_event &H2C, 1, &H2, 0    'on appuie et  on relache la touche snapshot
        'on va boucler tant que le contenu du clipboard n'est pas BITMAP soit (2) le temps necessaire a ce que
        'la touche print excecute sa tache et envoie les informations au clipboard
        Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0    'Or (Timer - T) > 1000
        If Me.Tag <> "" Then
            fname = Application.GetSaveAsFilename(InitialFileName:=Environ("userprofile") & "\Desktop", filefilter:="image Files (*.jpg), *.jpg", Title:="ENREGISTREMENT DE LA CAPTURE")
            If fname <> False Then chemin = fname Else Exit Sub
        Else
            chemin = Environ("userprofile") & "\Desktop\capture.jpg"
        End If
        'crée un graphique
        With ActiveSheet.ChartObjects.Add(0, 0, Me.Width, Me.Height)
            .Chart.Paste: .Chart.Export chemin, "jpg"    'colle l'image dans graphique puis exportation  le graphique en image jog
            .Delete
        End With
        'ActiveSheet.Paste
        Unload Me
        End If
    End Sub
     
    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        If GetActiveWindow() <> handleApp Then otherhandle = GetActiveWindow()
    End Sub
    edit :

    aurais-je oublié de préciser de nommer le userform "captur"
    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. #2
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 084
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 084
    Points : 5 371
    Points
    5 371
    Billets dans le blog
    14

    Par défaut

    Salut Patrick,
    Sympa cet utilitaire.

    Je préciserai juste pour la compréhension que CommandButton1_Click et CommandButton2_Click font références à des boutons SUR une feuille du classeur.

    et que c'est la taille (ajustable) du formulaire qui détermine l'étendue de la capture.

    En plus cela marche même sur des fenêtres en dehors de Excel. Bravo.

  3. #3
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 552
    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 : 10 552
    Points : 16 756
    Points
    16 756
    Billets dans le blog
    1

    Par défaut re

    bonjour oliv
    oui le but c'était ca pouvoir capturer n'importe quoi a l'écran (même ce qui n'est pas excel )

    il me reste un seul soucis a régler sur ce projet
    le fait que si on a deux fenêtre croisée dont l'une est Excel le fait d'activer le Userform réaffiche l'application au premier plan

    j'ai tout essayé rien n'y fait
    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. #4
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 084
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 084
    Points : 5 371
    Points
    5 371
    Billets dans le blog
    14

    Par défaut

    Citation Envoyé par patricktoulon Voir le message
    bonjour oliv
    ... si on a deux fenêtre croisée dont l'une est Excel le fait d'activer le Userform réaffiche l'application au premier plan
    ...
    c'est quoi 2 fenêtres croisées ?

  5. #5
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 552
    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 : 10 552
    Points : 16 756
    Points
    16 756
    Billets dans le blog
    1

    Par défaut RE

    RE
    deux fenêtre croisées c'est par exemple Excel affifhée (windowsate normal) avec une autre fenêtres la couvrant en partie

    le fait de cliquer sur l'userform pour capturer remet Excel au premier plan et donc la partie cachée d'Excel par l'autre fenêtre est de nous apparente
    ce qui a pour conséquence de capturer ce qu'il se trouve sous l'userform

    gênant quand on veux capturer les deux partie de fenêtres

    j'ai bien trouvé une solution mais elle ne me plais pas

    a savoir le même principe que l'outils de capture de Windows 7

    2 fenêtres (userform) l'un ayant la capture total de l'écran en plein écran et sans caption et l'autre faisant ce que celui actuel fait

    PS:pour du HD(capture autre définition) j'ai une autre solution si ca t'intéresse je crois même l'avoir déjà partagé
    c'est par ici
    https://www.developpez.net/forums/d1...rint-snapshot/

    si tu a une solution pour ce problème je suis preneur

    je me demande si il y a une api pour capter leur index en terme de positon se serait le top mémoriser avant click et repositionner l'ors du click avant capture

    démonstration du problème
    Nom : demo.gif
Affichages : 14
Taille : 743,7 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

  6. #6
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 084
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 084
    Points : 5 371
    Points
    5 371
    Billets dans le blog
    14

    Par défaut

    Salut,

    il faudrait passer l'autre fenêtre en TOP_MOST , mais je pense que simplement en reproduisant le ALT+TAB tu auras tes fenêtres à leur position précédente

  7. #7
    Expert éminent sénior
    Avatar de patricktoulon
    Profil pro
    Inscrit en
    avril 2009
    Messages
    10 552
    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 : 10 552
    Points : 16 756
    Points
    16 756
    Billets dans le blog
    1

    Par défaut re

    re
    bonjour oliv
    tu parle de simulation de key c'est ca ?

    je vais regarder ca
    merci

    edit :
    bon ben apres test c'est pire d'autant plus que la fenêtre capturée c'est celle qui s'affiche quand on tape ces deux touches et même en remettant l'usf au premier plan c'est cette fenêtre qui est capturée
    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. Réponses: 6
    Dernier message: 04/08/2007, 15h17
  2. [html:select] valeur par défaut avec liste dynamique
    Par CPI_en_mousse dans le forum Struts
    Réponses: 3
    Dernier message: 02/07/2007, 15h29
  3. [VBA-E]Selection dynamique avec souris de plages de cellules
    Par geeksideofme dans le forum Macros et VBA Excel
    Réponses: 17
    Dernier message: 08/05/2007, 15h25
  4. [VBA-E] Selection dynamique avec la sourie de plages de cellules Excel
    Par geeksideofme dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 30/04/2007, 12h20
  5. [BDD] Problème avec SELECT "dynamique"
    Par Vecine dans le forum PHP & MySQL
    Réponses: 3
    Dernier message: 29/03/2006, 12h11

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