すごろくメモ２

Public Type POINTAPI
x As Long
y As Long
End Type

Public Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long

Sub 座標調整()
Dim poi As POINTAPI
Call GetCursorPos(poi)
Range("O1").Value = poi.x
Range("O2").Value = poi.y
End Sub

Sub ナンバリング_リセット()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then
shp.Delete
End If
Next shp
End Sub

Sub ナンバリング_追加()
'最大値を取得
Dim shp As Shape
Dim max As Integer
Dim tmp_text As String
Dim tmp_int As Integer
For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then
tmp_text = shp.TextFrame2.TextRange.Characters.Text
If IsNumeric(tmp_text) Then
tmp_int = Val(tmp_text)
If max < tmp_int Then
max = tmp_int
End If
End If
End If
Next shp

'位置調整用の座標を取得
x_offset = Range("O1").Value
y_offset = Range("O2").Value

'クリック座標を取得
Dim poi As POINTAPI
Call GetCursorPos(poi)
If poi.x < x_offset Then
Application.StatusBar = "範囲外です"
Application.Wait Now() + TimeSerial(0, 0, 1)
Application.StatusBar = ""
Exit Sub
End If
If poi.y < y_offset Then
Application.StatusBar = "範囲外です"
Application.Wait Now() + TimeSerial(0, 0, 1)
Application.StatusBar = ""
Exit Sub
End If

'最大値+1のオブジェクトを追加
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
(poi.x - x_offset - 16) / 2, _
(poi.y - y_offset - 16) / 2, _
32, 32).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Str(max + 1)
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).ParagraphFormat.FirstLineIndent = 0
End Sub