D0090.PDF

Size: px

Start display at page:

Download "D0090.PDF"

よりとしかいて
5 years ago
Views:

2 g 180cm A A 0g 500g 500g 500g cm 500g 1kg

1 2 1 500g 500g 500g 2 A FreeFall 2 VBEditor 1 1 Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) '***** ***** Sub s_freefall() Dim PlotNo As Integer ' Dim y As Single

3 g 500g 500g 2 A FreeFall 2 VBEditor 1 1 Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) '***** ***** Sub s_freefall() Dim PlotNo As Integer ' Dim y As Single ' Dim myshape As Shape ' Dim i As Integer ' For Each myshape In Worksheets("FreeFall").Shapes If myshape.autoshapetype = msoshapeoval Then myshape.delete -1 End If Next ' Worksheets("FreeFall").Range("A2").CurrentRegion.Select PlotNo = Selection.Rows.Count - 1 For i = 1 To PlotNo y = Cells(i + 2, 2).Value * 1.5 ActiveSheet.Shapes.AddShape(msoShapeOval, 200, y, 15, 15).Select s_timewait (100) Next Range("A1").Select -2-3 '***** mymsec ***** Sub s_timewait(mymsec As Long) DoEvents Sleep mymsec 3

4 Win32API Sleep Declare Sleep 3 1 AutoShapeType msoshapeoval 1cm s_freefall ] 4

5 2 6 60km 60km cm (cm ) cm 6 y x V t v t Y x 7 5 x y 5

6 a s 2 vat s vt s? at 2 2 a 980cm 2 9.8m 2 6

7 2 v0m vv0al 1 2 s? v0t? at v0 r 11 v0 12 FREERALL.xls 13 start 7

8 Shift Ctrl Enter [start] 13 Shoot 1 2 Shoot 2 '***** ***** Sub s_sheetset() Worksheets("shoot").Columns("a:ax").ColumnWidth = 1.88 Worksheets("shoot").Rows("1:30").RowHeight = 15 8

9 L2 AE21 ZONE 1 =1"" ; G launch

10 3 '***** ***** Sub s_keyset() Application.OnKey "+{Right}", "s_radup" '[Shift] + [] Application.OnKey "+{Left}", "s_raddown" '[Shift] + [] Application.OnKey "^{Right}", "s_forceup" '[Ctrl] + [] Application.OnKey "^{Left}", "s_forcedown" '[Ctrl] + [] Application.OnKey "{Enter}", "s_fire" ' [Enter] '***** ***** Sub s_keyrelease() Application.OnKey "+{Right}" Application.OnKey "+{Left}" Application.OnKey "^{Right}" Application.OnKey "^{Left}" Application.OnKey "{Enter}" '***** 5 60 ***** Sub s_radup() Range("A4").Value = Range("A4").Value + 5 If Range("A4").Value > 60 Then Range("A4").Value = 60 s_launchset Sub s_raddown() Range("A4").Value = Range("A4").Value - 5 If Range("A4").Value < 5 Then Range("A4").Value = 5 s_launchset '***** ***** Sub s_forceup() Range("A6").Value = Range("A6").Value + 10 If Range("A6").Value > 200 Then Range("A6").Value = 200 Sub s_forcedown() Range("A6").Value = Range("A6").Value - 10 If Range("A6").Value < 50 Then Range("A6").Value = 50 '***** ***** Sub s_launchset() Dim LaunchHeight As Single Dim HeightScale As Single LaunchHeight = Tan(Range("A4").Value * 3.14 / 180) * ActiveSheet.Shapes("launch").Width HeightScale = LaunchHeight / ActiveSheet.Shapes("launch").Height ActiveSheet.Shapes("launch").ScaleHeight HeightScale, False, msoscalefrombottomright 10

11 3 OnKey 1 OnKey shift ^ ctrl 2 s_keyrelease 2 Shift Ctrl 17 s_launchset ScaleHeight 17 r a b' 3 msoscalefrombottomright 4 s_zoneset s_fire 2 11

12 4 '***** ***** Sub s_zoneset() Dim MarkNo As Integer Dim zbc As Long, zbr As Long Dim ZoneW As Integer, ZoneH As Integer Dim i As Integer zbc = Range("Zone").Column zbr = Range("Zone").Row ZoneW = Range("Zone").Columns.Count - 1 ZoneH = Range("Zone").Rows.Count - 1 MarkNo = 20 Range("E8").Value = MarkNo Range("Zone").Value = "" s_keyset Randomize For i = 1 To MarkNo Cells(Int((ZoneH + 1) * Rnd + zbr), Int((ZoneW + 1) * Rnd + zbc)).value = 1 Next '***** ***** Sub s_fire() Dim myshape As Shape Dim h As Double, r As Double Dim v0 As Double, g As Double Dim vx As Double, vy As Double Dim i As Double, t As Double Dim x As Double, y As Double Dim cw As Single, rw As Single ' For Each myshape In ActiveSheet.Shapes If myshape.autoshapetype = msoshapeoval Then myshape.delete End If Next ' h = 300 ' r = Range("A4").Value ' v0 = Range("A6").Value ' g = 9.8 ' vx = v0 * Cos(r * 3.14 / 180) ' vy = v0 * Sin(r * 3.14 / 180) ' cw = Range("L2").Width rw = Range("L2").Height ' With ActiveSheet.Shapes.AddShape(msoShapeOval, 0, h, 20, 20).Name = "ball".fill.presetgradient msogradientdiagonalup, 1, msogradientfire End With s_timewait (10) ' For i = 1 To 10 Step 0.2 t = i x = vx * t y = h - (vy * t - (g * (t ^ 2)) / 2) If y > 0 Then ActiveSheet.Shapes("ball").Left = Int(x) ActiveSheet.Shapes("ball").Top = Int(y) s_timewait (1) Cells(Int(y / rw) + 1, Int(x / cw) + 1).Value = "" Cells(Int(y / rw) + 2, Int(x / cw) + 1).Value = "" Cells(Int(y / rw) + 1, Int(x / cw) + 2).Value = "" Cells(Int(y / rw) + 2, Int(x / cw) + 2).Value = "" Range("E8").Value = Application.WorksheetFunction.Sum(Range("Zone")) End If Next ActiveSheet.Shapes("ball").Delete If Range("E8").Value = 0 Then End If MsgBox " " 12

s_zoneset 20 20 s_fire Left Top ball 4 50

13 s_zoneset s_fire Left Top ball 4 50 Left Top Zone 1 4 E8 1 Sum 18 0 Shoot

14 - - BefbreClose s_keyrelease ExcelVBA VB Excel 14

15 15

D0020.PDF

D0020.PDF n 3 X n Y n = Z n 17 1995 300 n n 2 3 2 a b c c 2 a 2 b 2 600 2000 322 3 15 2 3 580 3 1 5 4 3 2 1 300 2 1 2 1 1 ExcelVBA 2 VBA 1 VBA 2 API Sleep ExcelVBA 2 100 60 80 50 ExcelVBA API Sleep 3 100 60 (80