Autres encore un test sur excel 64 bits

[patricktoulon]

bonjour a tous
confinement oblige je fait mumuse
voudriez vous bien tester ceci
toujours dans le theme de l'utilisation des api (au black) sans déclaration
j'ai repris mon partOffScreenSnapshoteur
je voudrais savoir si ca fonctionne en 64 bits

ouvrir un nouveau fichier
ajouter un userform et lui mettre le backcolor de la couleur qui vous plaira
nommer ce userform SnapForm
et c'est tout (pas de contrôles ou quoi qu'est ce ,rien)
dans le module de ce userform mettre ce code

le mode d'emploi est simple il est expliqué en commentaires

'**************************************************************************************************
'              COLLECTION  UTILISATION DES API AVEC ExecuteExcel4Macro EPISODE 23
'                         ---------------------------------------------
'                        |SnapForm pour capturer une portion de l’écran|
'                         ---------------------------------------------

'Auteur: patricktoulon sur exceldownload
'version 1.0
'---------------------------------------------
'mode d'emploi:
'pour l'appeler de n'importe quel module:
'exemple:       SnapForm.GetCapture' a pour effet d'afficher le carré transparent(rouge)

'pour le redimensionner
' avec la souris vers  les angles ou les cotés en restant appuyé avec le bouton 1 de la souris comme une fenetre classique
'le mouse pointer(cursor) vous indique quand le bord est accrochable

' pour le déplacer
'avec la souris en restant appuyé vers le centre  du carré avec le bouton 1 de la souris

' pour capturer
'click droit dessus (ouvre la boite de dialogue "enregistrer sous")
'taper le nom dans le dialogue ou laisser celui par défaut et voila c'est capturé et enregistré
'**************************************************************************************************
Option Explicit
Public Function GetCapture()
    Me.Show
End Function


'restructuration et transparence de l'userform
Private Sub UserForm_Activate()
    Dim hwnd&
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94080080 & ")")      'api SetWindowLongA
    ExecuteExcel4Macro ("CALL(""user32"",""DrawMenuBar"",""JJJJJJ"", " & hwnd & ")")
    'Rajoute l'attribut transparent à la fenêtre..
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -20 & ", " & &H80000 & ")")     'api SetWindowLongA
    '125 = Taux de transparence de 0 à 255
    ExecuteExcel4Macro ("CALL(""user32"",""SetLayeredWindowAttributes"",""JJJJJ"",""" & hwnd & """,""" & 0 & """,""" & 40 & """,""" & &H2 & """)")
End Sub

'prise de capture avec le click droit de la souris
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim hwnd&, fichier As Variant, shp As Shape
    If Button = 2 Then
        hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'api GetActiveWindow
        ExecuteExcel4Macro ("CALL(""user32"",""SetLayeredWindowAttributes"",""JJJJJ"",""" & hwnd & """,""" & 0 & """,""" & 0 & """,""" & &H2 & """)")
        ExecuteExcel4Macro ("CALL(""user32"",""keybd_event"",""JJJJJ""," & 44 & ", " & 1 & ", " & 0 & ", " & 0 & ")")      'api SetWindowLongA
        ExecuteExcel4Macro ("CALL(""user32"",""keybd_event"",""JJJJJ""," & 44 & ", " & 1 & ", " & &H2 & ", " & 0 & ")")     'api SetWindowLongA
        ChDir (Environ("userprofile") & "\DeskTop")
        fichier = Application.GetSaveAsFilename(CurDir & "\" & "Captured_By_SnapForm", filefilter:="image Files (*.jpg;*.gif), *.jpg;*.gif", Title:="ENREGISTREMENT DE LA CAPTURE")
        If fichier = False Then Unload Me: Exit Sub
        Me.Hide: ActiveSheet.Paste
        With ActiveSheet
            Set shp = .Shapes(.Shapes.Count)
            With .ChartObjects.Add(shp.Left + 200, shp.Top, shp.Width, shp.Height)
                .Chart.Paste: .Chart.Export Filename:=fichier & ".jpg", FilterName:="jpg"
                .Delete
                shp.Delete
            End With
        End With
        Unload Me
    End If
End Sub

'deplacement et deformation sans api
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Static xx#
    Static yy#
    Dim mp As Variant, H$, Coté$
    If Y < 10 Then H = "H" Else H = "M"
    If Y > Me.InsideHeight - 10 Then H = "B"
    If X < 10 Then Coté = "G" Else Coté = "M"
    If X > Me.InsideWidth - 10 Then Coté = "D"
    mp = H & Coté
    mp = Switch(mp = "HG", 8, mp = "BD", 8, mp = "HD", 6, mp = "BG", 6, mp = "HM", 7, mp = "BM", 7, mp = "MM", 0, mp = "MG", 9, mp = "MD", 9)
    If Me.MousePointer <> mp Then Me.MousePointer = mp
    If Button = 1 Then
        xx = IIf(xx = 0, X, xx): yy = IIf(yy = 0, Y, yy)
        Select Case H & Coté
        Case "MM": Me.Move Me.Left + (X - xx), Me.Top + (Y - yy): Exit Sub
        Case "HG": Me.Width = Me.Width - (X - xx): Me.Left = Me.Left + (X - xx): Me.Height = Me.Height - (Y - yy): Me.Top = Me.Top + (Y - yy)
        Case "MG": Me.Width = Me.Width - (X - xx): Me.Left = Me.Left + (X - xx)
        Case "BG": Me.Width = Me.Width - (X - xx): Me.Left = Me.Left + (X - xx): Me.Height = Y + 5
        Case "HD": Me.Width = X + 5: Me.Height = Me.Height - Y + 5: Me.Top = Me.Top + (Y - 5)
        Case "MD": Me.Width = X + 5
        Case "BD": Me.Width = X + 5: Me.Height = Y + 5
        Case "HM": Me.Height = (Me.Height - Y): Me.Top = Me.Top + Y
        Case "BM": Me.Height = Y + 5
        End Select
    Else
        xx = 0: yy = 0
    End If
End Sub

merci d'avance pour les retours

 

[patricktoulon]

oserais -je dire que nous vas pas nous faire C.. pour un p(et)

 

[Usine à gaz]

Re- Patrick,
chez moi à l'exécution "SnapForm.Show" :

Mais après, je suis bloqué et obligé de sortir sauvagement avec le gestionnaire des tâches !
lioànel,

 

[TooFatBoy]

je développe rien avec Lionel je lui donne les macros dont il a besoins si sa demande est possible
d'autant plus que ce sujet n'a rien a voir avec lionel

et toi aurais tu pris ta tisane ce matin

J'ai pris mes médicaments, oui.
Mais ça ne pas mieux pour autant. Hélas...

Mais je ne pige pas bien pourquoi tu m'agresses de la sorte, ni pourquoi tu réponds aux questions que je posais à Yoyo...

 

[Staple1600]

Re

>•patricktoulon
Merci pour l'édition
Mais encore un effort c'est pas 600 mais 1600


[aparté bis- incroyable de devoir le préciser]
patricktoulon
Je m'efforce de respecter l'orthographe de tous les pseudos des membres du forum.
Et ce par simple courtoisie.
[aparté bis- incroyable de devoir le préciser]

 

[patricktoulon]

Lionel clique droit sur le carré
purré c'est pas peine d'avoir tout mis en commentaire

 

[Usine à gaz]

Ben OUI, ça c'est vrai Marcel, c'était pour moi lol ... tu dérailles Patrick

 

[patricktoulon]

 

[Usine à gaz]

@ Patrick : en cliquant droit dans le carré, il me demande d'enregistrer un jpeg et ensuite, je peux sortir normalement

 

[patricktoulon]

non je déraille pas mais avant d'avoir une réponse bonne ou mauvaise
il faut toujours que je débâte de sur mon projet et ça ça me gonfle tout simplement parce que on en est a 24 posts et il y en a qu'un qui a essayé et encore pas foutu de lire les commentaires
et a chacun de mes posts c'est pareil après on s'étonne pourquoi les posts durent des plombes
(testez participez/ ne testez pas bye!bye!!) faites comme vous voulez
c'est cash pistache chez moi

 

[Usine à gaz]

Patrick : en cliquant droit dans le carré, il me demande d'enregistrer un jpeg et ensuite, je peux sortir normalement.
C'est ce que tu attendais ,

 

[patricktoulon]

et alors ca marche ou pas
alors a tu essayé le redimensionnement du carré transparent en te promenant avec la souris sur les bords et les angles
a tu vérifié la ou tu a enregistré si la capture c'est bien faite
Rassure moi tu est en 64

 

[Staple1600]

Re

•>patricktoulon
*Tu sais déjà qu'arthour est en 64 bits, non ?
A moins qu'il faille que tu ranges aussi dans cette catégorie

et encore pas foutu de lire les commentaires
et a chacun de mes posts c'est pareil après on s'étonne pourquoi les posts durent des plombes

*: cf ton autre post de test "API au black"

 

[TooFatBoy]

non je déraille pas mais avant d'avoir une réponse bonne ou mauvaise
il faut toujours que je débâte de sur mon projet et ça ça me gonfle tout simplement parce que on en est a 24 posts et il y en a qu'un qui a essayé et encore pas foutu de lire les commentaires
et a chacun de mes posts c'est pareil après on s'étonne pourquoi les posts durent des plombes
(testez participez/ ne testez pas bye!bye!!) faites comme vous voulez
c'est cash pistache chez moi

C'est toi qui es parti en live tout seul, juste parce que tu n'as pas su lire mon message correctement.
Ce n'est pas grave. Je ne t'en veux pas plus que ça.
D'ailleurs, je te le prouve : je suis allé jusqu'à tester ton code. C'est pour dire.
Mais hélas, je ne sais pas comment le faire fonctionner.

Rassure moi tu est en 64

Ah, c'est marrant, c'est exactement ce que je lui demandais dans mon premier message... LOL
Et il a répondu que oui, il est bien en 64 bits.

 

[Usine à gaz]

Re-Patrick
Je suis bourrin mais pas à ce point là lol :

ça beug quand on veut re-dimenssionner le caréé :

L'image est enregistrée là où je le demande et elle est claire.
lionel

 

[patricktoulon]

re
ce qui est attendu et faisable

c'est pas compliqué
on ouvre le userform
il est translucide
on le déplace avec le bouton gauche de la souris au milieu de celui ci en restant appuyé
on le déforme par les angles ou coté de la même manière qu'une fenêtre classique
on click droit , le dialog s'ouvre annuler pour annuler ou enregistrer pour enregistrer en ayant renseigné le nom ou en laissant celui par défaut