友人に頼まれて、かつJavaScriptとjQueryの勉強も兼ねてツールを作ってみた。
といってもいきなりは難しいから、Excel版でプロタイプを作ってみた。
風呂の中、電車の中でロジックを考えて、昼休みに一気に作り込み。
※電車の中でシェイプの使い方は事前勉強
1時間で出来たことは、我ながら。。。
でも、本命のWEB版は、、、挫折しそう。
Excel版の特徴:
- 画像ファイルを順番に読み込んでシェイプに入れ込み、名前を振る
- 各シェイプクリック時のイベントを作成、でもシェイプ毎はしんどいので1つの関数に統一
※機能というか動きは一緒なので
'シェイプへの画像入れ込み、共通イベントの作成
Sub read_card_make_shape()
Dim myFileName As String
Dim myShape As Shape, item_name As String
Dim D As String: D = Chr(34)
Dim Y As Integer
'事前準備した画像フォルダへのパス
myFileName = "c:\temp\game.img\"
Y = 2: Do While Sheets("data").Cells(Y, 1).Value <> "": Y = Y + 1: Loop: Y = Y - 1
For i = 2 To Y
'画像ファイルをシェイプにセット
Set myShape = ActiveSheet.Shapes.AddPicture( _
fileName:=myFileName & Sheets("data").Cells(i, 1).Value & ".jpg", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=((i - 2) Mod 10) * 62, _
Top:=((i - 2) \ 10) * 92 + 250, _
Width:=60, _
Height:=90)
'シェイプに命名、クリック時のイベントにシェイプ名を渡す
item_name = Sheets("data").Cells(i, 1).Value
myShape.Name = item_name
ActiveSheet.Shapes(item_name).OnAction = "'card_click" & D & item_name & D & "'"
Next
End Sub
Sub card_click(KEY As String)
'クリックしたシェイプの名前をExcelセルへセット(あとはVlookup頼み)
Dim YY As Integer
YY = 3: Do While Sheets("main").Cells(YY, 1).Value <> "": YY = YY + 1: Loop
If YY > 14 Then Exit Sub
Sheets("main").Cells(YY, 1).Value = KEY
End Sub
Sub delete_line()
'削除時は名称を消せば後の情報も自動で消える(Vlookup頼み)
Dim YY As Integer
YY = 2: Do While Sheets("main").Cells(YY, 1).Value <> "": YY = YY + 1: Loop
Debug.Print YY
If YY < 4 Then Exit Sub
Sheets("main").Cells(YY - 1, 1).Value = ""
End Sub