XL 2016 Rotation continue d'une image autour d'axe y et à l'ouverture de fichier

[lakriti said]

Bonjour à tous ;

j'aimerais boucler mon macro qui permet de faire la rotation de logo (image s'appelle "Logo") de notre entreprise OCP d'une façon permanant et à l'ouverture de fichier excel "DA IN PROCESS" dans la feuille "Data" et voila mon macro


Public Sub Workbook_Open()

Dim n As Integer

Worksheets("Data").Activate
ActiveSheet.Shapes("Logo").LockAspectRatio = False
n = 5
#If VBA7 Then
n = 10
#End If
GrowShape ActiveSheet.Shapes("Logo"), n
SpinShape ActiveSheet.Shapes("Logo"), n

End Sub

Function SpinShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:Expands a shape into view
' Parameters: Shape The shape to animate
' Step Larger #s animate faster
' Steps should divide 90 evenly
' Example: SpinShape ActiveSheet.Shapes("Logo"), 10
' Date Ini Modification
' 01/10/11 CWH Initial Programming
' 12/08/13 CWH XL2013 Compatibility

Const Pi = 3.14159265358979
Dim sng01 As Single '1 Degree in Radians
sng01 = Pi / 180

Dim lCenterX As Long 'Shape's center X coordinate
Dim lCenterY As Long 'Shape's center Y coordiante
Dim lWidth As Long 'Shape's width
Dim lHeight As Long 'Shape's height
Dim l As Long 'Generic Counter for the loop

With Shape
.LockAspectRatio = False
'Remember shape's original dimensions
lCenterX = .Width / 2 + .Left
lCenterY = .Height / 2 + .Top
lWidth = .Width
lHeight = .Height
Shape.Visible = True
'Animation Loop
For l = 0 To 360 Step Step
.Width = lWidth * Abs(Cos(l * sng01))
.Left = lCenterX - .Width / 2
If l = 90 Or l = 270 Then .Flip msoFlipHorizontal
DoEvents
Next l
'Restore shape's original dimensions
.Width = lWidth
.Height = lHeight
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
End With
End Function

Function GrowShape(ByRef Shape As Shape, Step As Integer) As Boolean

Dim lCenterX As Long 'Shape's center X coordinate
Dim lCenterY As Long 'Shape's center Y coordiante
Dim lWidth As Long 'Shape's width
Dim lHeight As Long 'Shape's height
Dim l As Long 'Generic Counter for the loop

With Shape
'Remember shape's original dimensions
lCenterX = .Width / 2 + .Left
lCenterY = .Height / 2 + .Top
lWidth = .Width
lHeight = .Height
Shape.Visible = True
'Animation Loop
For l = 0 To lWidth Step Step
.Width = l
.Height = l * lHeight / lWidth
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
DoEvents
Next l
'Restore shape's original dimensions
.Width = lWidth
.Height = lHeight
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
End With

End Function

 

[Dranreb]

Bonjour.
Il n'y a pas de générateur d'évènements Workbook dans les modules d'objets Worksheet. Seulement dans le module ThisWorkbook.

 

[lakriti said]

Bonjour et merci pour votre reactivité M.Dranreb à votre avis qui est ce qu'on peut on faire pour solder cet situation; sciemment que le principe que je peux avoir "rotation continue de LOGO"
ms

 

[Dranreb]

Bonjour.
Ben déjà mettre la Public Sub Workbook_Open() en Private Sub Workbook_Open() mais dans le module ThisWorkbook et non dans le module de l'objet Worksheet représentant la feuille. Dans ce dernier vous pourriez à la rigueur mettre une Worksheet_Activate qui fait la même chose.

 

[lakriti said]

LE PROBLEME SE MANIFESTE TOUJOURS
MS

 

[Dranreb]

Enfin moi j'avais exécuté la procédure manuellement, puisqu'elle ne pouvait pas s'exécuter toute seule, et ça avait bien fait bougé le logo.

 

[lakriti said]

ON SAIT BIEN QUE LE LOGO SE TOURNE MAIS PAS SANS ARRET
JE VAIS BOUCLER LE MACRO C'EST CA LE VRAI PROBLEME

 

[Dranreb]

Mettez peut être la procédure dans un module standard et faite la exécuter périodiquement par un Application.Ontime

 

[Modeste geedee]

Bonsour®

Bonjour à tous ;

j'aimerais boucler mon macro qui permet de faire la rotation de logo (image s'appelle "Logo") de notre entreprise OCP d'une façon permanant et à l'ouverture de fichier excel "DA IN PROCESS" dans la feuille "Data"

supprime les macros concernées déjà existantes
dans le module "Thisworkbook "
inserer ce code :

Private Sub Workbook_Deactivate()
anime = False
Application.OnTime earliesttime = NextTime, procedure:="macro1", schedule:=False
End Sub

Private Sub Workbook_Open()
anime = True
Macro1
End Sub

dans un module standard
inserer ce code

Public NextTime As Double, anime As Boolean
Sub Macro1()
Dim x As Integer, logo As Shape
Set logo = ActiveSheet.Shapes("Logo")
For x = 1 To 360 Step 10
                logo.ThreeD.RotationX = x
                DoEvents
    Next
   NextTime = Now + TimeValue("00:00:02")
   If anime = True Then Application.OnTime NextTime, "macro1"
End Sub
Sub Logo_Cliquer()
anime = Not anime
Call Macro1
End Sub

l'animation démarre dés l'ouverture

l'arret ou re-demarrage de l'animation ce fait par un click sur le logo

 

[lakriti said]

je vous remercie infiniment M.XLDnaute Barbatruc ainsi que vos collègues pour ce magnifique job
vous êtes génial