Changer l'angle d'une image dans un UserForm

Bonjour a tous, j'aimerais charger une image d'un bouton Volume et de le faire tourner a l'aide des évenements disponible comme "mouse..." , donc j'aimerais pouvoir en VBA changer l'angle de l'image (PNG ou JPEG). Est-ce possible?

Bonjour,

Pour changer l'angle de votre bouton:

    With ActiveSheet.Shapes("mettre ici le nom de votre bouton")
        .Rotation = .Rotation + 10 'mettre la valeur de votre choix et changer de signe pour tourner dans le sens inverse
    End With

Cdlt

Edit:

Zut! j'ai zappé le fait que c'était dans un formulaire.

Bonjour,

Sauf erreur de ma part, on ne peut changer directement l'angle dans un userform. Il faut passer par une étape intermédiaire consistant à changer l'angle dans la forme présente dans un onglet, en capturer l'image et l'importer dans le userform.

Dans le fichier joint, les touches A et Z augmentent ou diminuent l'angle du bouton dans le userform.

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

      If KeyCode = vbKeyA Then
         AugmenterLAngle
         Apercu_Dans_Uf
      End If

      If KeyCode = vbKeyZ Then
         DiminuerLAngle
         Apercu_Dans_Uf
     End If

End Sub

Le code Apercu_Dans_Uf du module 2 n'est pas de moi :

Option Explicit

Public Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(8) As Byte
End Type

Public Type PICTDESC
  cbSize As Long
  picType As Long
  hImage As Long
End Type

Public Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function CloseClipboard& Lib "user32" ()
Public Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Public Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long

Public mode As Long

Sub VidePP()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub

Sub Apercu_Dans_Uf()

Dim NOM_IMAGE As Variant

    'On copie la selection dans le clipboard
    Sheets("Feuil1").Shapes("Bouton").CopyPicture xlScreen, xlBitmap 'Copie la selection dans le clipboard
    'Prend l'image dans le cliboard
    Dim hCopy&: OpenClipboard 0&
    hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H8)
    CloseClipboard

    If hCopy = 0 Then Exit Sub

    Const IPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
    Dim iPic As IPicture, tIID As GUID, tPICTDEST As PICTDESC, Ret As Long
    Ret = IIDFromString(StrConv(IPictureIID, vbUnicode), tIID)

    If Ret Then Exit Sub

    With tPICTDEST
         .cbSize = Len(tPICTDEST)
         .picType = 1
         .hImage = hCopy
    End With

    Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)

    If Ret Then Exit Sub

    UserForm1.Image1.Picture = iPic

    Set iPic = Nothing
    VidePP

End Sub

Option Explicit

Sub ImporterPhoto()
Dim Sh As Shape
Dim Img As PictureFormat

    Set Sh = Worksheets("Feuil1").Shapes("Bouton")
    With UserForm1
         Apercu_Dans_Uf
        .Show
    End With

End Sub

Sub AugmenterLAngle()

    With Sheets("Feuil1")
         .Shapes("Bouton").IncrementRotation 10
    End With

End Sub

Sub DiminuerLAngle()

    With Sheets("Feuil1")
         .Shapes("Bouton").IncrementRotation -10
    End With

End Sub

Bonjour a vous deux, intéressant de pouvoir tourner l'image. Est-ce que ca fonctionnerais pour une image jpeg ou png que je mettrais sur ma feuille ou seulement pour des formes Excel? Par contre l'image ne se charge pas dans le UserForm et il y a une erreur avec l'instruction " Ret = IIDFromString(StrConv(IPictureIID, vbUnicode), tIID)" alors j'ai du la mettre en commentaire. J'imagine que cette ligne est importante pour le transfert de l'image.

Salut,

Je ne vois pas de déclaration pour du 64bit le problème avec la fonction IIDFromString vient peut-être de là.

Notre bon vieux ImageList remit aux gouts du jour ne ferait-il pas l'affaire ? et pas d'Apis comme ça

ImageList OCX | 10Tec

pas certain de comprendre, mais oui j'utilise la version 64 bits et j'ai du mettre PtrSafe aux déclarations

Bonjour Capucine,

Le fichier que j'ai mis en ligne ne fonctionne pas ?

Nb : Il faut préalablement charger l'image sur l'onglet.

la forme est bien présente sur ma feuille a l'ouverture et si je clic sur le bouton, j'ai une erreur de "fichier n'existe pas. La ligne qui ne marche pas dans le sub "Apercu_Dans_Uf" est: Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)

Si je met cette ligne en commentaire, la forme sur la feuille tourne bien, mais évidemment la forme ne se met pas sur le UserForm.

Est-ce qu'il me manque une référence? Chez toi, est-ce que tout fonctionne?

Oui, cela fonctionne chez moi, sinon je n'aurais pas mis en ligne ce fichier.

Est-ce que la solution de Jean-Paul te convient ?

Donc Eric, chez toi, la forme se charge dans le UserForm? je vais essayer de comprendre quel est mon probleme avec OleCreatePictureIndirect.

Jean-Paul, imageList, je ne sais pas trop quoi faire avec ca, est-ce une référence que je peux ajouter? Ca permettrait de faire la rotation d'image dans mon UserForm. J'ai essayé des codes comme ceci mais les instructions visant a tourner l'image me donne toujours une erreur. PictureRotation et RotateImage ne fonctionne pas.

Private Sub Image28_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim angle As Double
'    angle = Math.Atan(Y - Me.Image28.Height / 2, X - Me.Image28.Width / 2) * 180 / Math.Pi ' Calcule l'angle de rotation en fonction de la position de la souris

    angle = WorksheetFunction.Atan2(Y - Me.Image28.Height / 2, X - Me.Image28.Width / 2) * 180 / WorksheetFunction.Pi()

    angle = angle + 90 ' Ajuste l'angle pour correspondre à l'orientation de l'image
    Me.Image28.PictureRotation = angle ' Fait pivoter l'image
End Sub

'Private Sub CommandButton24_Click()
'    Dim img As Object
'    Set img = LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\Boutons\bouton rotatif.jpg")
'    Image28.Picture = RotateImage(img, 45)
'End Sub

'Private Sub Image28_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'    If Button = 1 Then
'        Dim angle As Single
'        angle = -Application.WorksheetFunction.Atan2(X - Me.Image28.Width / 2, Y - Me.Image28.Height / 2) * 180 / Application.WorksheetFunction.Pi
'        Me.Image28.picture = RotateImage(LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\Boutons\bouton rotatif.jpg"), angle)
'    End If
'End Sub

'Private Function RotateImage(ByVal img As Object, ByVal angle As Single) As Object
'    Dim imgTemp As Object
'    Set imgTemp = CreateObject("WIA.ImageFile")
'    Set imgTemp = img
'    Dim bmp As Object
'    Set bmp = CreateObject("System.Drawing.Bitmap")
'    bmp.Width = img.Width
'    bmp.Height = img.Height
'    Dim gr As Object
'    Set gr = CreateObject("System.Drawing.Graphics")
'    gr.DrawImage img, 0, 0, img.Width, img.Height
'    gr.RotateTransform angle
'    gr.DrawImage img, 0, 0, img.Width, img.Height
'    Set RotateImage = bmp.FromHbitmap(gr.GetHdc)
'    gr.ReleaseHdc
'End Function

Salut ImageList est un contrôle invisible, il te permet de stocker les images du mouvement du bouton.

• Tu crée le nombre d'image voulu à différente position 0, 15, 30, 45, par exemple
• Ensuite sur clic tu sélectionnes l'image du bouton par son index un petit exemple en pièce jointe
• Bien lire la doc
• Penser à enregisrer l'ocx dans SysWow64 avec regsvr32

Jean-Paul, je ne suis pas tres bon pour installer des trucs comme ca, malheureusement. Je comprend le principe des multiples images. Le fichier Excel est vide, est-ce normal?

Tu vas dans l'environnement VBE et tu lances UserForm1

il y a juste la feuille et thisworkbook, sinon le fichier est vide

Je viens de me rendre compte que j'ai sauvegardé le fichier en xls

la, les fichiers ne sont pas trouvé (erreur a l'exécution du code). J'imagine que je n'ai pas placé les truc a la bonne place.

• tu veux dire quoi par: Penser à enregisrer l'ocx dans SysWow64 avec regsvr32 ?

On va y arriver

colles les images dans le même répertoire

Il faudra peut-être les recharger dans l'ImageList

Jean-Paul m'a donner une approche intéressante qui consiste a avoir plusieurs images a différents angles. Voici mon code, il permet de faire tourner un bouton sur un UserForm simplement en se déplacant avec la souris (l'évenement mouse_move est utilisé). Alors simplement mettre ajouter une image avec la boite a outil du UserForm, ici image28, et le code y mettra l'image JPEG correspondant a l'angle. Il vous suffira de placer toute vos images JPEG dans un dossier et de bien le pointer. Mon code permet d'avoir une nouvelle image du bouton a tout les 45 degrés, mais pourrait facilement etre modifié pour une meilleure apparence.

Private Sub Image28_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) 'dans ce code, j'ai commencé par creer une image avec la boit a outil (image28) et on y placera les images de boutons

        Dim angle As Double
        Dim imageIndex As Integer
        Dim images As New Collection

        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\12h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\13h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\15h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\18h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\21h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\13h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\15h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\18h.jpg")
        images.Add LoadPicture("C:\Users\michel\piano\GOOGLE DRIVE\21h.jpg")

        If X - Me.Image28.Width / 2 = 0 And Y - Me.Image28.Height / 2 = 0 Then 'arrive si le curseur est en plein centre. Ici, on veut éviter l'erreur avec Atan2 et des parametres=0
             angle = 0
        Else
             angle = WorksheetFunction.Atan2(Y - Me.Image28.Height / 2, X - Me.Image28.Width / 2) * 180 / WorksheetFunction.Pi()
        End If

        angle = 360 - angle ' Ajuste l'angle pour correspondre à un mouvement horaire

        'Ajuster l'angle en fonction de sa valeur pour demeurer toujours dans la plage 0-360 degrés
        If angle < 0 Then
            angle = angle + 360
        ElseIf angle > 360 Then
            angle = angle - 360
        End If

        imageIndex = Int(angle / 45) 'Ceci sélectionnera l'image en fonction de l'intervalle de 45 degrés
        Me.TextBox2.Value = imageIndex
        Set Image28.Picture = images(imageIndex + 1) 'Définir l'image à afficher en fonction de l'index sélectionné

End Sub

Salut,

Le contrôle imageList fait pareil en plus simple non ?

Dans l'environnement VBE tu agrandis le formulaire tu y verra le contrôle ImageList, un clic sur personnalisé dans les propriétés et là tu pourras charger les photos que tu veux, de plus il accepte tous les format images , et gère la transparence.

Jean-Paul, ca l'air chouette imageList . Je ne peux pas ouvrir le dernier fichier compressé que tu as envoyé.