XL 2013 le 12 doit commencer en haut

[patricktoulon]

Bonjour a tous
je me suis fait une horloge entierement construite avec des shapes
mais j'ai un soucis pour commencer la création des nombres (heure) au bon endroit
la partie qui déraille

Option Explicit
Sub deleteshappe()
   Dim shap As Shape
   For Each shap In ActiveSheet.Shapes
        If Left(shap.Name, 2) = "sh" Then shap.Delete
    Next
End Sub

Sub test()
    Dim y0#, x0#, xx#, yy#, Rayon#, Pi#, shap, i&
    deleteshappe
    Rayon = 120
    y0 = 140    'y0 doit etre au minimum egal  au rayon
    x0 = 160
     Pi = 3.14159265358979
    For i = 1 To 12
        xx = x0 + (Rayon + 10) * Cos((2 * Pi / 12) * i)
        yy = y0 + (Rayon + 10) * Sin((2 * Pi / 12) * i)
        Set shap = ActiveSheet.Shapes.AddShape(msoShapeOval, xx, yy, 40, 25)
        With shap
            .Name = "sh" & i
           .Fill.ForeColor.RGB = vbBlack
             .TextFrame2.VerticalAnchor = msoAnchorMiddle
           .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .TextFrame2.TextRange.Characters.Text = i
            .TextFrame2.TextRange.Font.Size = 9
            
        End With
    ActiveSheet.DrawingObjects(shap.Name).Font.Color = RGB(255, 150, 0)
    Next

End Sub

merci pour le coup de main

 

[laurent950]

Bonjour Patrick

xx = x0 + (Rayon + 10) * Cos((2 * Pi / 12) * (i + 9))
yy = y0 + (Rayon + 10) * Sin((2 * Pi / 12) * (i + 9))

Option Explicit
Sub deleteshappe()
   Dim shap As Shape
   For Each shap In ActiveSheet.Shapes
        If Left(shap.Name, 2) = "sh" Then shap.Delete
    Next
End Sub

Sub test()
    Dim y0#, x0#, xx#, yy#, Rayon#, Pi#, shap, i&
    deleteshappe
    Rayon = 120
    y0 = 140    'y0 doit etre au minimum egal  au rayon
    x0 = 160
     Pi = 3.14159265358979
    For i = 1 To 12
        xx = x0 + (Rayon + 10) * Cos((2 * Pi / 12) * (i + 9))
        yy = y0 + (Rayon + 10) * Sin((2 * Pi / 12) * (i + 9))
        Set shap = ActiveSheet.Shapes.AddShape(msoShapeOval, xx, yy, 40, 25)
        With shap
            .Name = "sh" & i
           .Fill.ForeColor.RGB = vbBlack
             .TextFrame2.VerticalAnchor = msoAnchorMiddle
           .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
            .TextFrame2.TextRange.Characters.Text = i
            .TextFrame2.TextRange.Font.Size = 9
            
        End With
    ActiveSheet.DrawingObjects(shap.Name).Font.Color = RGB(255, 150, 0)
    Next
End Sub

 

[patricktoulon]

re
merci laurent
Impec

 

[Staple1600]

Bonjour le fil

Juste parce qu'Excel connait PI et pour les chicons

Option Explicit
Sub deleteshape()
   Dim shap As Shape
   For Each shap In ActiveSheet.Shapes
        If Left(shap.Name, 2) = "sh" Then shap.Delete
    Next
End Sub

Sub test()
    Dim y0#, x0#, xx#, yy#, Rayon#, vPi#, shap As Shape, i&
    deleteshape
    Rayon = 120
    y0 = 140    'y0 doit etre au minimum egal  au rayon
    x0 = 160
     vPi = Application.Pi()
    For i = 1 To 12
        xx = x0 + (Rayon + 10) * Cos((2 * vPi / 12) * (i + 9))
        yy = y0 + (Rayon + 10) * Sin((2 * vPi / 12) * (i + 9))
        Set shap = ActiveSheet.Shapes.AddShape(msoShapeOval, xx, yy, 40, 25)
        With shap
        .Name = "sh" & i
        .Fill.ForeColor.RGB = vbBlack
            With .TextFrame2
                .VerticalAnchor = 3: .TextRange.ParagraphFormat.Alignment = 2
                .TextRange.Characters.Text = i: .TextRange.Font.Size = 9
                .TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(255, 150, 0)
            End With
        End With
    Next
End Sub

Bon appétit!

 

[dysorthographie]

Bonjour Patrick,
j'arrive un peut tard mais je te donne quand même

Type Point
    x As Double
    y As Double
End Type
Private Sub Timer1_Timer()
Static J, h, M, s
With XYSeconde(Secondes, Second(Time), DEP)
    Secondes.X2 = .x
    Secondes.Y2 = .y
End With
With XYMinutes(Minutes, Minute(Time), DEP)
    Minutes.X2 = .x
    Minutes.Y2 = .y
End With
With XYHeures(Heures, CInt(Format(Time, "h AMPM")), DEP)
    Heures.X2 = .x
    Heures.Y2 = .y
End With
Label1.Caption = Time
Label2.Caption = Format(Now, "DDDD DD")
 If J = "" Then J = Day(Now)
 If h = "" Then h = Hour(Now)
 If M = "" Then M = Minute(Now)
 If M = "" Then s = Second(Now)

If s <> Second(Now) Then s = Second(Now): RaiseEvent Secondes
If M <> Minute(Now) Then M = Minute(Now): RaiseEvent Minutes
If h <> Hour(Now) Then h = Hour(Now): RaiseEvent Heures
If J <> Day(Now) Then J = Day(Now): RaiseEvent Jours
DoEvents
End Sub
Private Function XYSeconde(ByRef Ln As Line, ByVal Secondes As Integer, L As Double) As Point
Secondes = Secondes - 15
XYSeconde.x = Ln.X1 + Math.Cos(Secondes * (PI / 30)) * (L - (L * 0.15))
XYSeconde.y = Ln.Y1 + Math.Sin(Secondes * (PI / 30)) * (L - (L * 0.15))
End Function
Private Function XYMinutes(ByRef Ln As Line, ByVal Minutes As Integer, L As Double) As Point
Minutes = Minutes - 15
XYMinutes.x = Ln.X1 + Math.Cos(Minutes * (PI / 30)) * (L - (L * 0.2))
XYMinutes.y = Ln.Y1 + Math.Sin(Minutes * (PI / 30)) * (L - (L * 0.2))
End Function
Private Function XYHeures(ByRef Ln As Line, ByVal Heures As Integer, L As Double) As Point
Heures = Heures - 3
XYHeures.x = Ln.X1 + Math.Cos(Heures * (PI / 6)) * (L - (L * 0.5))
XYHeures.y = Ln.Y1 + Math.Sin(Heures * (PI / 6)) * (L - (L * 0.4))
End Function

 

[patricktoulon]

Bonsoir Robert
il en manque un peu là non ?
chez moi j'ai 4 lignes en rouge aussi

 

[dysorthographie]

en fait il s'agit d'un extrait d'un control personnalisé que j'ais réalisé apprès avoir lu l'autre poste auquel tu as également participé!

ce qui est en rouge c'est l'activation des évènements du contrôle!

voici la totalité du code!

Dim Alpha As Double 'déplacement angulaire
Dim Ang As Double 'position angulaire
Dim iSec As Integer 'compteur de déplacement
Const PI = 3.14159265358979
Private DEP   As Double 'longueur de l'aiguille des secondes
Type Point
    x As Double
    y As Double
End Type
Public Event Secondes()
Public Event Minutes()
Public Event Heures()
Public Event Jours()
Public Event Click()
Public Property Get FontColor() As OLE_COLOR
FontColor = BackColor
End Property
Public Property Let FontColor(Value As OLE_COLOR)
BackColor = Value
End Property
Public Property Get TextBackGround() As OLE_COLOR
Label2.ForeColor = Label2.ForeColor
End Property
Public Property Let TextBackGround(Value As OLE_COLOR)
Label2.ForeColor = Value
End Property
Public Property Get SecondeColor() As OLE_COLOR
SecondeColor = Secondes.BorderColor
End Property
Public Property Let SecondeColor(Value As OLE_COLOR)
Secondes.BorderColor = Value
End Property
Public Property Get HeureColor() As OLE_COLOR
HeureColor = Heures.BorderColor
End Property
Public Property Let HeureColor(Value As OLE_COLOR)
Heures.BorderColor = Value
End Property
Public Property Get MinuteColor() As OLE_COLOR
MinuteColor = Minutes.BorderColor
End Property
Public Property Let MinuteColor(Value As OLE_COLOR)
Minutes.BorderColor = Value
End Property
Public Property Get Start() As Boolean
Start = CBool(Timer1.Interval)
End Property
Public Property Let Start(Value As Boolean)
Timer1.Interval = IIf(Value, 500, 0)
End Property
Public Property Get HorlogeDigital() As Boolean
HorlogeDigital = Label1.Visible
End Property
Public Property Let HorlogeDigital(Value As Boolean)
Label1.Visible = Value
End Property
Public Property Get DateDigital() As Boolean
DateDigital = Label2.Visible
End Property
Public Property Let DateDigital(Value As Boolean)
Label2.Visible = Value
End Property
Public Property Get Cadrant() As Picture
Set Cadrant = Quadrant.Picture
End Property
Public Property Set Cadrant(Value As Picture)
Quadrant.Picture = Value
End Property

Private Sub Label3_Click()
RaiseEvent Click
End Sub


Private Sub Timer1_Timer()
Static J, h, M, s
With XYSeconde(Secondes, Second(Time), DEP)
    Secondes.X2 = .x
    Secondes.Y2 = .y
End With
With XYMinutes(Minutes, Minute(Time), DEP)
    Minutes.X2 = .x
    Minutes.Y2 = .y
End With
With XYHeures(Heures, CInt(Format(Time, "h AMPM")), DEP)
    Heures.X2 = .x
    Heures.Y2 = .y
End With
Label1.Caption = Time
Label2.Caption = Format(Now, "DDDD DD")
 If J = "" Then J = Day(Now)
 If h = "" Then h = Hour(Now)
 If M = "" Then M = Minute(Now)
 If M = "" Then s = Second(Now)

If s <> Second(Now) Then s = Second(Now): RaiseEvent Secondes
If M <> Minute(Now) Then M = Minute(Now): RaiseEvent Minutes
If h <> Hour(Now) Then h = Hour(Now): RaiseEvent Heures
If J <> Day(Now) Then J = Day(Now): RaiseEvent Jours
DoEvents
End Sub
Private Function XYSeconde(ByRef Ln As Line, ByVal Secondes As Integer, L As Double) As Point
Secondes = Secondes - 15
XYSeconde.x = Ln.X1 + Math.Cos(Secondes * (PI / 30)) * (L - (L * 0.15))
XYSeconde.y = Ln.Y1 + Math.Sin(Secondes * (PI / 30)) * (L - (L * 0.15))
End Function
Private Function XYMinutes(ByRef Ln As Line, ByVal Minutes As Integer, L As Double) As Point
Minutes = Minutes - 15
XYMinutes.x = Ln.X1 + Math.Cos(Minutes * (PI / 30)) * (L - (L * 0.2))
XYMinutes.y = Ln.Y1 + Math.Sin(Minutes * (PI / 30)) * (L - (L * 0.2))
End Function
Private Function XYHeures(ByRef Ln As Line, ByVal Heures As Integer, L As Double) As Point
Heures = Heures - 3
XYHeures.x = Ln.X1 + Math.Cos(Heures * (PI / 6)) * (L - (L * 0.5))
XYHeures.y = Ln.Y1 + Math.Sin(Heures * (PI / 6)) * (L - (L * 0.4))
End Function


Private Sub UserControl_Initialize()
UserControl_Resize
End Sub

Private Sub UserControl_InitProperties()
UserControl_Resize
End Sub

Private Sub UserControl_Resize()
Width = Height
Quadrant.Height = Height
Quadrant.Width = Width
DEP = Quadrant.Height / 2

Heures.X1 = Quadrant.Left + DEP
Heures.X2 = Quadrant.Left + DEP
Heures.Y1 = Quadrant.Top + DEP
Heures.Y2 = Quadrant.Top + (DEP * 0.5)
Heures.BorderWidth = 1 + (Quadrant.Height * 0.003)

Minutes.X1 = Quadrant.Left + (Quadrant.Width / 2)
Minutes.X2 = Quadrant.Left + (Quadrant.Width / 2)
Minutes.Y1 = Quadrant.Top + DEP
Minutes.Y2 = Quadrant.Top + (DEP * 0.3)
Minutes.BorderWidth = 1 + (Quadrant.Height * 0.0025)

Secondes.X1 = Quadrant.Left + (Quadrant.Width / 2)
Secondes.X2 = Quadrant.Left + (Quadrant.Width / 2)
Secondes.Y1 = Quadrant.Top + DEP
Secondes.Y2 = Quadrant.Top + (DEP * 0.3)
Secondes.BorderWidth = 1 + (Quadrant.Height * 0.0006)
'
Label1.Height = Quadrant.Height * 0.06
Label1.Width = Quadrant.Width * 0.26
Label1.Top = Quadrant.Top + Quadrant.Height - (Label1.Height * 4.3)
Label1.Left = Quadrant.Left + (Quadrant.Width / 2) - (Label1.Width / 2.2)
Label1.FontSize = Label1.Height * 0.03

Label2.Height = Quadrant.Height * 0.08
Label2.Width = Quadrant.Width * 0.4
Label2.Top = Quadrant.Top + (Label2.Height * 3.3)
Label2.Left = Quadrant.Left + (Quadrant.Width / 2) - (Label2.Width / 2.2)
Label2.FontSize = Label2.Height * 0.03

Label3.Height = Quadrant.Height
Label3.Width = Quadrant.Width
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
    .WriteProperty "start", CBool(Timer1.Interval), 0
    .WriteProperty "HorlogeDigital", Label1.Visible, True
    .WriteProperty "DateDigital", Label2.Visible, True
    .WriteProperty "Cadrant", Quadrant.Picture, Quadrant.Picture
    .WriteProperty "HeureColor", Heures.BorderColor, &H80000008
    .WriteProperty "SecondeColor", Secondes.BorderColor, &H80000008
    .WriteProperty "MinuteColor", Minutes.BorderColor, &H80000008
    .WriteProperty "TextBackGround", Label2.ForeColor, &H80000012
    .WriteProperty "FontColor", BackColor, &H8000000F
End With
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
    FontColor = .ReadProperty("FontColor", BackColor)
    TextBackGround = .ReadProperty("TextBackGround", Label2.ForeColor)
    SecondeColor = .ReadProperty("SecondeColor", Secondes.BorderColor)
     EguilleColor = .ReadProperty("EguilleColor", Heures.BorderColor)
    Start = .ReadProperty("Start", 0)
    Set Quadrant.Picture = .ReadProperty("Cadrant", Quadrant.Picture)
    HorlogeDigital = .ReadProperty("HorlogeDigital", Label1.Visible)
    DateDigital = .ReadProperty("DateDigital", Heures.BorderColor)
End With
End Sub

 

[dysorthographie]

si tu veux je peux le placer sur Guil ab et t'envoyer le lien?