オートシェイプを作成し回転させる : Excel(エクセル)

Excel Tipsメニューに戻る

スポンサーリンク






Excelではオートシェイプを使って様々な図形を作成することができますが、これを回転させることでもっと楽しめそうです。ここでは、回転前の図形を作成し、さらに同じ位置で図形を作成し、これを徐々に回転させています。

ExcelシートのVBAコード

Option Explicit

'Windowsが起動してからの経過時間 API
Private Declare Function GetTickCount Lib "kernel32" () As Long

'mSecタイマー
Private Sub ExTimer(tim As Long)
    Dim st As Long
    
    '開始時間を取得
    st = GetTickCount
    DoEvents
    Do
        If GetTickCount - st >= tim Then
            '時間が経過した
            Exit Do
        End If
        DoEvents
    Loop
End Sub

'シェイプを作成し回転する
Sub ExMakeShape()
    Dim tshape As Shape
    Dim i As Double
    
    '元の図形を作成
    With ActiveSheet.Range("D9:E15")
        Set tshape = ActiveSheet.Shapes.AddShape(Type:=msoShapeLeftArrow, _
        Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    End With
    Set tshape = Nothing

    '回転させる図形を作成
    With ActiveSheet.Range("D9:E15")
        Set tshape = ActiveSheet.Shapes.AddShape(Type:=msoShapeLeftArrow, _
        Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
        '90度まで徐々に回転
        For i = 1 To 90
            '100mSecタイマー
            ExTimer 100
            '1度回転
            Call tshape.IncrementRotation(1)
        Next
    End With
    Set tshape = Nothing

End Sub

Private Sub CommandButton1_Click()
    ExMakeShape
End Sub

スポンサーリンク



Excel実行画面

ボタンをクリックすると、2個のシェイプを作成し、2個目を回転させます。
下の左向きの矢印が作成した時点の図形です。上が回転させた図形です。
開始ボタンを矢印の図形

Excel Tipsメニューに戻る

スポンサーリンク






■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved