walec91

Zegar

Feb 1st, 2021
1,308
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Const PI As Double = 3.141592
  2. Dim KolejneUruchomienie As Double
  3. Sub ZrobZegar_Walkowski()
  4. Wykres
  5. Tarcza
  6. Wskazowki
  7. End Sub
  8. Sub Wykres()
  9. ActiveSheet.Shapes.AddChart(xlXYScatterLines, 30, 30, 300, 300).Select
  10. ActiveChart.SetSourceData Source:=Workbooks(1).Worksheets(1).Range("$A$1:$F$6")
  11. ActiveSheet.ChartObjects(1).Chart.HasLegend = False
  12. ActiveSheet.ChartObjects(1).Chart.HasTitle = False
  13. ActiveSheet.ChartObjects(1).Chart.ChartArea.Interior.ColorIndex = 20
  14. ActiveSheet.ChartObjects(1).Chart.PlotArea.Interior.ColorIndex = 20
  15. End Sub
  16. Sub Tarcza()
  17. Dim X(1 To 12) As Double
  18. Dim Y(1 To 12) As Double
  19. Dim Rozmiar As Double
  20. Rozmiar = 1
  21. For i = 1 To 12
  22.     X(i) = Rozmiar * Sin(i * (2 * PI / 12))
  23.     Y(i) = Rozmiar * Cos(i * (2 * PI / 12))
  24. Next i
  25.  
  26. ActiveChart.SeriesCollection(1).XValues = X
  27. ActiveChart.SeriesCollection(1).Values = Y
  28. For i = 1 To 12
  29.     ActiveChart.SeriesCollection(1).Points(i).HasDataLabel = True
  30.     ActiveChart.SeriesCollection(1).Points(i).DataLabel.Text = Str(i)
  31. Next i
  32.  
  33. ActiveChart.Axes(xlValue).MajorGridlines.Delete
  34. ActiveChart.Axes(1).Delete
  35. ActiveChart.Axes(2).Delete
  36. ActiveChart.SeriesCollection(1).Border.ColorIndex = 20
  37. ActiveChart.SeriesCollection(1).MarkerStyle = xlMarkerStyleNone
  38. ActiveChart.SeriesCollection(2).MarkerStyle = xlMarkerStyleNone
  39. End Sub
  40. Sub Wskazowki()
  41. Dim X1(1 To 2) As Variant
  42. Dim Y1(1 To 2) As Variant
  43. X1(1) = 0
  44. Y1(1) = X1(1)
  45. X1(2) = 0.7 * Sin(Second(Time) * (2 * PI / 60))
  46. Y1(2) = 0.7 * Cos(Second(Time) * (2 * PI / 60))
  47. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(3).XValues = X1
  48. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(3).Values = Y1
  49. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(3).MarkerStyle = xlMarkerStyleNone
  50. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(3).Border.Weight = 3
  51. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(3).Border.ColorIndex = 23
  52.  
  53. Dim X2(1 To 2) As Variant
  54. Dim Y2(1 To 2) As Variant
  55. X2(1) = 0
  56. Y2(1) = X2(1)
  57. X2(2) = 0.5 * Sin((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))
  58. Y2(2) = 0.5 * Cos((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60))
  59. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(4).XValues = X2
  60. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(4).Values = Y2
  61. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(4).MarkerStyle = xlMarkerStyleNone
  62. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(4).Border.Weight = 3
  63. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(4).Border.ColorIndex = 53
  64.  
  65. Dim X3(1 To 2) As Variant
  66. Dim Y3(1 To 2) As Variant
  67. X3(1) = 0
  68. Y3(1) = X3(1)
  69. X3(2) = 0.3 * Sin((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))
  70. Y3(2) = 0.3 * Cos((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12))
  71. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(5).XValues = X3
  72. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(5).Values = Y3
  73. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(5).MarkerStyle = xlMarkerStyleNone
  74. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(5).Border.Weight = 3
  75. ActiveSheet.ChartObjects(1).Chart.SeriesCollection(5).Border.ColorIndex = 43
  76.  
  77. KolejneUruchomienie = Now + TimeValue("00:00:01")
  78. Application.OnTime KolejneUruchomienie, "Wskazowki"
  79.  
  80. End Sub
RAW Paste Data