[TOP][基本操作] [関数] [お遊び] [マクロを登録][ユーザー定義表示形式][自作メニュー]


<3、お遊び編>

エクセルでちょっとしたお遊びができないか、と考えています。良いアイデアありませんか?

mailto:マイニー・ヨシツネ
2001/3/4 更新

<<お気に入りのマクロをコピーして、新しいブックののVBAモジュールにコピーしてください。>>

連珠ゲーム’正方形の升目を作って、クリックすると黒丸、白丸を交互に入力します。(それだけ)


'**********連珠マクロ(ここから)**********戻る
'メニュー「マクロの実行」で、「初期設定」マクロを実行してください
'それで設定は終わりです
'「連珠」シートで楽しんでください

'//////ThisWorkbookにペーストしてください(ここから)//////
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Const Kuro = "●"
Const Siro = "○"
Const 工事中 = 0
Dim a_target_cell As Range

If Sh.Name <> "連珠" Then Exit Sub
If Range("状態").Value = 工事中 Then Exit Sub

Set a_target_cell = Cells(Target.Row, Target.Column) '複数セル入力を避ける
Select Case Range("切替").Value
Case 0
a_target_cell.Value = Kuro
Case 1
a_target_cell.Value = Siro
End Select
Range("切替").Value = (Range("切替").Value + 1) Mod 2

End Sub
'//////ThisWorkbookにペーストしてください(ここまで)//////

'++++++標準モジュールを挿入してペーストしてください(ここから)++++++
Const kstrKuro = "●"
Const kstrSiro = "○"
Dim strUser$

Sub 初期設定()
シート構造設定
Sheets("連珠").Select
連珠枠設定
End Sub
Private Sub 連珠枠設定()
With Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ColumnWidth = 2
.RowHeight = Cells(1, 1).Width
End With
End Sub

Private Sub シート構造設定()
If ActiveWorkbook.Sheets.Count < 2 Then Sheets.Add
Sheets(1).Name = "連珠"
Sheets(2).Name = "preference"

Sheets("preference").Select
Range("A1").FormulaR1C1 = "連珠開始(1)、または保守作業(0)"
Range("B2").FormulaR1C1 = "B1に0を入力すると連珠は中断となります"
Range("B1").Select
ActiveWorkbook.Names.Add Name:="状態", RefersToR1C1:="=preference!R1C2"
With Selection
.NumberFormatLocal = "[=1]""連珠開始"";[=0]""工事中"";G/標準"
.Font.ColorIndex = 3
.Value = 1
End With

Range("A3").FormulaR1C1 = "白黒切替データ"
Range("B3").Select
ActiveWorkbook.Names.Add Name:="切替", RefersToR1C1:="=preference!R3C2"

Cells.EntireColumn.AutoFit
リセットボタン設定
End Sub
Private Sub リセットボタン設定()
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 25.5, 56.25, 117#, _
45#).Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 42
.Characters.Text = "リセット"
.Characters(Start:=1, Length:=4).Font.Size = 18
.OnAction = "消去"
.AutoSize = True
End With
End Sub
Sub 消去()
Sheets("連珠").Cells.ClearContents
Range("切替").Value = 0
End Sub
'++++++標準モジュールを挿入してペーストしてください(ここまで)++++++
'**********連珠マクロ(ここまで)**********

トップページへ戻る