友人に頼まれて、かつ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