

エクセル2000で作成したアニメーション用のVBAですが、  
最近のエクセル2010ではアニメーション表示はVBAのコードが変更されているためか動きません。

エクセル2000でないと動きませんが、2010でも動くようにするには何処を変更すれば良いのか分かりませんでした。  
ご知見を伺いたく投稿しました。

[code]

    Private Sub CommandButton1_Click()
    Dim ND, NEX, i As Integer
    Dim T, UD(1 To 20), RUD(1 To 20), KY(1 To 20), RR(1 To 20), DF(1 To 20) As Single
    Dim ABC, FN As String
    
    ActiveSheet.Range(Cells(1, 7), Cells(10000, 150)).ClearContents
    ABC = ActiveSheet.Range("B3").Value
    If Right(ABC, 1) <> "¥" Then
    ABC = ABC + "¥"
    End If
    FN = ActiveSheet.Range("B4").Value
    Open ABC + FN For Input As #1
    Input #1, ND
    Input #1, NEX
    ActiveSheet.Range("B5").Value = ND
    ActiveSheet.Range("B6") = NEX
    For i = 1 To NEX
    For j = 1 To ND
    Input #1, T, UD(j), RUD(j), KY(j), RR(j), DF(j)
    ActiveSheet.Cells(i, 7 * j).Value = T
    ActiveSheet.Cells(i, 7 * j + 1).Value = UD(j)
    ActiveSheet.Cells(i, 7 * j + 2).Value = RUD(j)
    ActiveSheet.Cells(i, 7 * j + 3).Value = KY(j)
    ActiveSheet.Cells(i, 7 * j + 4).Value = RR(j)
    ActiveSheet.Cells(i, 7 * j + 5).Value = DF(j) / 120
    Next j
    Next i
    Close #1
    
    ActiveSheet.Range("A1").Select
    End Sub
    
    Private Sub CommandButton2_Click()
    Dim TIT,WB As String
    Dim i, j, ND, NEX As Integer
    Dim Sht1 As Worksheet
    Dim ERC1, ERC2 As Range
    WB = ActiveWorkbook.Name
    Set Sht1 = Worksheets("表示")
    ND = ActiveSheet.Range("B5").Value
    NEX = ActiveSheet.Range("B6").Value
    i = ActiveSheet.Range("B7").Value
    j = 4 + 7 * i
    Set ERC1 = Sht1.Range(Cells(1, j + 1), Cells(NEX, j + 1))
    Set ERC2 = Sht1.Range(Cells(1, j), Cells(NEX, j))
    TIT = StrConv(Str(i), vbWide) + "777"
    
    ActiveSheet.ChartObjects("グラフ2").Activate
    ActiveChart.ChartArea.Select
    With ActiveChart
    .HasTitle = True
    .ChartTitle.Characters.Text = TIT
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).XValues = ERC1
    ActiveChart.SeriesCollection(1).Values = ERC2
    ActiveWindow.Visible = False
    Windows(WB).Activate
    Set Sht1 = Nothing
    Set ERC1 = Nothing
    Set ERC2 = Nothing
    Range("A1").Select
    End Sub
    
    Private Sub CommandButton3_Click()
    Range("A1:F27").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Range("A1:C2").Select
    
    End Sub
    
    
    Private Sub CommandButton1_Click()
    Dim NE, ND As Integer
    Dim i, j, k, Speed As Integer
    Dim X1, X2, X3, Z, DT, A As Single
    Dim st1 As Worksheet
    Set st1 = Worksheets("表示")
    
    NE = st1.Range("B6").Value
    ND = st1.Range("B5").Value
    DT = st1.Range("G1").Value
    A = ActiveSheet.Range("B7").Value
    Speed = 11 - ActiveSheet.Range("C5").Value
    
    Z = 162
    For k = 1 To NE
    X1 = 162 + st1.Cells(k, 8).Value * A
    If ND > 1 Then
    X2 = 162 + st1.Cells(k, 15).Value * A
    End If
    If ND = 3 Then
    X3 = 162 + st1.Cells(k, 22).Value * A
    End If
    If ND = 1 Then
    ActiveSheet.Shapes("Freeform 7").Select
    Selection.ShapeRange.Nodes.SetPosition 2, X1, 160.5
    Selection.ShapeRange.Nodes.SetPosition 3, X1 - 30, 160.5
    Selection.ShapeRange.Nodes.SetPosition 4, X1 + 54, 130.5
    Selection.ShapeRange.Nodes.SetPosition 5, X1 + 138, 160.5
    Selection.ShapeRange.Nodes.SetPosition 6, X1, 160.5
    Selection.ShapeRange.Nodes.SetPosition 7, X1 + 108, 160.5
    End If
    If ND = 2 Then
    ActiveSheet.Shapes("Freeform 2").Select
    Selection.ShapeRange.Nodes.SetPosition 2, X1, 228.75
    Selection.ShapeRange.Nodes.SetPosition 3, X1 + 108, 228.75
    ActiveSheet.Shapes("Freeform 7").Select
    Selection.ShapeRange.Nodes.SetPosition 1, X1, 228.75
    Selection.ShapeRange.Nodes.SetPosition 8, X1 + 108, 228.75
    
    Selection.ShapeRange.Nodes.SetPosition 2, X2, 160.5
    Selection.ShapeRange.Nodes.SetPosition 3, X2 - 30, 160.5
    Selection.ShapeRange.Nodes.SetPosition 4, X2 + 54, 130.5
    Selection.ShapeRange.Nodes.SetPosition 5, X2 + 138, 160.5
    Selection.ShapeRange.Nodes.SetPosition 6, X2, 160.5
    Selection.ShapeRange.Nodes.SetPosition 7, X2 + 108, 160.5
    End If
    If ND = 3 Then
    ActiveSheet.Shapes("Freeform 11").Select
    Selection.ShapeRange.Nodes.SetPosition 2, X1, 297#
    Selection.ShapeRange.Nodes.SetPosition 3, X1 + 108, 297#
    
    ActiveSheet.Shapes("Freeform 2").Select
    Selection.ShapeRange.Nodes.SetPosition 1, X1, 297#
    Selection.ShapeRange.Nodes.SetPosition 4, X1 + 108, 297#
    
    ActiveSheet.Shapes("Freeform 2").Select
    Selection.ShapeRange.Nodes.SetPosition 2, X2, 228.75
    Selection.ShapeRange.Nodes.SetPosition 3, X2 + 108, 228.75
    
    ActiveSheet.Shapes("Freeform 7").Select
    Selection.ShapeRange.Nodes.SetPosition 1, X2, 228.75
    Selection.ShapeRange.Nodes.SetPosition 8, X2 + 108, 228.75
    
    Selection.ShapeRange.Nodes.SetPosition 2, X3, 160.5
    Selection.ShapeRange.Nodes.SetPosition 3, X3 - 30, 160.5
    Selection.ShapeRange.Nodes.SetPosition 4, X3 + 54, 130.5
    Selection.ShapeRange.Nodes.SetPosition 5, X3 + 138, 160.5
    Selection.ShapeRange.Nodes.SetPosition 6, X3, 160.5
    Selection.ShapeRange.Nodes.SetPosition 7, X3 + 108, 160.5
    End If
    
    Range("a10").Value = DT * k
    
    For i = 1 To 100
    For j = 1 To Speed * 100
    dummy = i + j
    Next j
    Next i
    
    Next k
    Set st1 = Nothing
    Range("a10").Select
    
    End Sub
    
    Private Sub CommandButton2_Click()
    ActiveSheet.Shapes("Freeform 2").Select
    Selection.ShapeRange.Nodes.SetPosition 1, 162, 297
    Selection.ShapeRange.Nodes.SetPosition 2, 162, 228.75
    Selection.ShapeRange.Nodes.SetPosition 3, 162 + 108, 228.75
    Selection.ShapeRange.Nodes.SetPosition 4, 162 + 108, 297
    
    ActiveSheet.Shapes("Freeform 7").Select
    Selection.ShapeRange.Nodes.SetPosition 1, 162, 228.75
    Selection.ShapeRange.Nodes.SetPosition 8, 162 + 108, 228.75
    
    Selection.ShapeRange.Nodes.SetPosition 2, 162, 160.5
    Selection.ShapeRange.Nodes.SetPosition 3, 162 - 30, 160.5
    Selection.ShapeRange.Nodes.SetPosition 4, 162 + 54, 130.5
    Selection.ShapeRange.Nodes.SetPosition 5, 162 + 138, 160.5
    Selection.ShapeRange.Nodes.SetPosition 6, 162, 160.5
    Selection.ShapeRange.Nodes.SetPosition 7, 162 + 108, 160.5
    ND = Worksheets("表示").Range("B5").Value
    If ND = 1 Then
    ActiveSheet.Shapes("Rectangle 12").Top = 228.75
    End If
    If ND = 2 Then
    ActiveSheet.Shapes("Rectangle 12").Top = 297#
    End If
    If ND = 3 Then
    ActiveSheet.Shapes("Rectangle 12").Top = 365.25
    End If
    Range("a10").Value = 0!
    Range("B7").Select
    End Sub
    
    Private Sub ScrollBar1_Change()
    ActiveSheet.Range("C5") = ScrollBar1.Value
    ActiveSheet.Range("B7").Select
    End Sub
    
[/code]


CC BY-SA 4.0
2022-02-02T01:22:02.227
86084
2022-02-02T02:55:01.490
2022-02-02T02:55:01.490
3060
50731
question
vba
エクセル2000で作成したアニメーション用VBAを2010で動かしたい