令和６年１２月３０日
令和６年年越し準備（しめ縄作り）を行いました。
今年は太く立派なしめ縄ができました。氏子の皆様ありがとうごございます。
NEWS
令和６年１０月６日 三島神社 例大祭 神輿渡御を行いました。
Sub PIANO_MAKE_Columns()
Start_C = 3
Start_Row = 1001
Start_Row = 1
Split_Row = 40
KEY_C = 4
' 音楽記号 ♪ ?????♪??
key_n = 52
ActiveWindow.FreezePanes = False
Range(Cells(Start_Row, Start_C), Cells(Start_Row + 4, Start_C + key_n * KEY_C + 5 * KEY_C)).Select
' Selection.EntireRow.Delete
Selection.Delete Shift:=xlToLeft
DoEvents: DoEvents:
Range("A5").Select: Range("A3") = "テンポ": Range("A4") = "(BPM)": Select Case Range("A5").Value = "": Case True: Range("A5") = "♪=500": End Select
Range("B3") = "コード" + vbLf + "休符" + vbLf + "Timber=11": Range("B4") = "Am,C": Range("B5") = "■":
Range(Columns(Start_C), Columns(Start_C + key_n * KEY_C + KEY_C)).ColumnWidth = 0.8
Range(Rows(Start_Row), Rows(Start_Row + 2)).RowHeight = 50
' Range(Rows(Start_Row), Rows(Start_Row + 4)).NumberFormatLocal = "@"
Range(Rows(Start_Row), Rows(Start_Row + 4)).NumberFormatLocal = "G/標準"
For C_n = 0 To key_n
Set KEYBOAD = Range(Cells(Start_Row, Start_C + KEY_C * C_n), Cells(Start_Row + 2, Start_C + KEY_C * C_n + KEY_C - 1))
KEYBOAD.Borders(xlDiagonalDown).LineStyle = xlNone
KEYBOAD.Borders(xlDiagonalDown).LineStyle = xlNone
KEYBOAD.Borders(xlDiagonalUp).LineStyle = xlNone
With KEYBOAD.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
With KEYBOAD.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
With KEYBOAD.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
With KEYBOAD.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
KEYBOAD.Borders(xlInsideVertical).LineStyle = xlNone
KEYBOAD.Borders(xlInsideHorizontal).LineStyle = xlNone
KEYBOAD.Interior.Color = RGB(200, 255, 255)
CB_n = C_n Mod 7
Oct_B = Int(C_n / 7) + 1
Select Case CB_n
Case 0: note = "A" + Str(Oct_B - 1) + vbLf + Str(Oct_B * 12 + 1 + 8): note_1 = Oct_B * 12 + 1 + 8: note_2 = Oct_B * 12 + 1 + 9: Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 1), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 1))
Case 1: note = "B" + Str(Oct_B - 1) + vbLf + Str(Oct_B * 12 + 1 + 10): note_1 = Oct_B * 12 + 1 + 10: note_2 = "": Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 1), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 0))
Case 2: note = "C" + Str(Oct_B - 0) + vbLf + Str(Oct_B * 12 + 1 + 11): note_1 = Oct_B * 12 + 1 + 11: note_2 = Oct_B * 12 + 1 + 12: Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 0), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 1))
Case 3: note = "D" + Str(Oct_B - 0) + vbLf + Str(Oct_B * 12 + 1 + 13): note_1 = Oct_B * 12 + 1 + 13: note_2 = Oct_B * 12 + 1 + 14: Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 1), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 1))
Case 4: note = "E" + Str(Oct_B - 0) + vbLf + Str(Oct_B * 12 + 1 + 15): note_1 = Oct_B * 12 + 1 + 15: note_2 = "": Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 1), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 0))
Case 5: note = "F" + Str(Oct_B - 0) + vbLf + Str(Oct_B * 12 + 1 + 16): note_1 = Oct_B * 12 + 1 + 16: note_2 = Oct_B * 12 + 1 + 17: Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 0), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 1))
Case 6: note = "G" + Str(Oct_B - 0) + vbLf + Str(Oct_B * 12 + 1 + 18): note_1 = Oct_B * 12 + 1 + 18: note_2 = Oct_B * 12 + 1 + 19: Set KEY_A = Range(Cells(Start_Row, Start_C + KEY_C * C_n + 1), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C - 1 - 1))
End Select
KEY_A.MergeCells = True: 'KEY_A.HorizontalAlignment = xlCenter: KEY_A.VerticalAlignment = xlCenter:
KEY_A.Value = note_1: KEY_A.Orientation = 90: KEY_A.Font.Color = RGB(0, 0, 0)
Set KEY_D = Range(Cells(Start_Row + 2, Start_C + KEY_C * C_n), Cells(Start_Row + 2, Start_C + KEY_C * C_n + KEY_C - 1))
KEY_D.MergeCells = True: KEY_D.HorizontalAlignment = xlCenter: KEY_D.VerticalAlignment = xlBottom: KEY_D.Value = note
Set KEY_D = Range(Cells(Start_Row + 3, Start_C + KEY_C * C_n), Cells(Start_Row + 3, Start_C + KEY_C * C_n + KEY_C - 1))
KEY_D.MergeCells = True: KEY_D.HorizontalAlignment = xlCenter: KEY_D.VerticalAlignment = xlCenter: KEY_D.Value = note_1
KEY_D.Font.Color = RGB(0, 0, 0): KEY_D.Interior.Color = RGB(100, 155, 155)
Set KEY_D1 = Range(Cells(Start_Row + 4, Start_C + KEY_C * C_n + 2), Cells(Start_Row + 4, Start_C + KEY_C * C_n + KEY_C + 1))
Set KEY_B1 = Range(Cells(Start_Row + 0, Start_C + KEY_C * C_n + 3), Cells(Start_Row + 1, Start_C + KEY_C * C_n + KEY_C + 0))
Select Case C_n < key_n: Case True:
Select Case note_2 <> "": Case True:
KEY_D1.MergeCells = True: KEY_D1.HorizontalAlignment = xlCenter: KEY_D1.VerticalAlignment = xlCenter: KEY_D1.Value = note_2
KEY_D1.Font.Color = RGB(250, 250, 250): KEY_D1.Interior.Color = RGB(150, 150, 150)
KEY_B1.MergeCells = True: KEY_B1.HorizontalAlignment = xlCenter: KEY_B1.VerticalAlignment = xlCenter: KEY_B1.Value = note_2
KEY_B1.Font.Color = RGB(250, 250, 250): KEY_B1.Interior.Color = RGB(150, 150, 150): KEY_B1.Orientation = 90:
End Select:
End Select:
Next C_n
For C_n = 0 To key_n - 1
CB_n = C_n Mod 7
Select Case CB_n
' Case 0, 2, 3, 4, 6
Case 0, 2, 3, 5, 6
Set KEYBOAD = Range(Cells(Start_Row, Start_C + KEY_C - 1 + KEY_C * C_n), Cells(Start_Row + 1, Start_C + KEY_C + KEY_C * C_n))
KEYBOAD.Borders(xlDiagonalDown).LineStyle = xlNone
KEYBOAD.Borders(xlDiagonalUp).LineStyle = xlNone
With KEYBOAD.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
With KEYBOAD.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
With KEYBOAD.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
With KEYBOAD.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
KEYBOAD.Borders(xlInsideVertical).LineStyle = xlNone
KEYBOAD.Borders(xlInsideHorizontal).LineStyle = xlNone
KEYBOAD.Interior.Color = RGB(0, 0, 0)
End Select
Next C_n
Call FormatConditionMacro
Call WorkArea_Line
ActiveWindow.FreezePanes = False
Range("C6").Select
ActiveWindow.FreezePanes = True
End Sub
Private Sub FormatConditionMacro()
Start_C = 3: Start_Row = 1: Split_Row = 40: KEY_C = 4: key_n = 52:
Cells.FormatConditions.Delete
Set KEY_D = Range(Cells(Start_Row + 3, Start_C), Cells(Start_Row + 3, Start_C + KEY_C * key_n + KEY_C - 1))
KEY_D.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=0"
KEY_D.FormatConditions(1).Interior.Color = RGB(100, 155, 155):
KEY_D.FormatConditions(1).StopIfTrue = False:
With KEY_D.FormatConditions(1).Borders(xlLeft): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
With KEY_D.FormatConditions(1).Borders(xlRight): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
With KEY_D.FormatConditions(1).Borders(xlTop): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
With KEY_D.FormatConditions(1).Borders(xlBottom): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
KEY_D.FormatConditions(1).Font.Color = RGB(250, 250, 250)
Set KEY_D1 = Range(Cells(Start_Row + 4, Start_C), Cells(Start_Row + 4, Start_C + KEY_C * key_n + KEY_C + 1))
KEY_D1.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=0"
KEY_D1.FormatConditions(1).Interior.Color = RGB(150, 150, 150):
KEY_D1.FormatConditions(1).StopIfTrue = False:
With KEY_D1.FormatConditions(1).Borders(xlLeft): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
With KEY_D1.FormatConditions(1).Borders(xlRight): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
With KEY_D1.FormatConditions(1).Borders(xlTop): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
With KEY_D1.FormatConditions(1).Borders(xlBottom): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlThin: End With
KEY_D1.FormatConditions(1).Font.Color = RGB(250, 250, 250)
End Sub
Private Sub WorkArea_Line()
Start_C = 3: Start_Row = 1: Split_Row = 40: KEY_C = 4: key_n = 52: S_line = 100: O_line = 100:
Set WorkArea = Range(Rows(Start_C + 7), Rows(S_line))
WorkArea.Borders(xlDiagonalDown).LineStyle = xlNone
WorkArea.Borders(xlDiagonalUp).LineStyle = xlNone
WorkArea.Borders(xlEdgeLeft).LineStyle = xlNone
WorkArea.Borders(xlEdgeTop).LineStyle = xlNone
WorkArea.Borders(xlEdgeBottom).LineStyle = xlNone
WorkArea.Borders(xlEdgeRight).LineStyle = xlNone
WorkArea.Borders(xlInsideVertical).LineStyle = xlNone
WorkArea.Borders(xlInsideHorizontal).LineStyle = xlNone
Set Tempo = Range(Cells(Start_Row + 5, 1), Cells(O_line, 1))
Tempo.Value = "♪"
Dim C_d(1 To 128) As Variant
Dim R_d(1 To 128) As Variant
Black_key = 1: White_key = 3:
For C_n = 0 To key_n
CB_n = C_n Mod 7
Oct_B = Int(C_n / 7) + 1
Select Case CB_n
Case 0: note_1 = Oct_B * 12 + 1 + 8: note_2 = Oct_B * 12 + 1 + 9
Case 1: note_1 = Oct_B * 12 + 1 + 10: note_2 = ""
Case 2: note_1 = Oct_B * 12 + 1 + 11: note_2 = Oct_B * 12 + 1 + 12
Case 3: note_1 = Oct_B * 12 + 1 + 13: note_2 = Oct_B * 12 + 1 + 14
Case 4: note_1 = Oct_B * 12 + 1 + 15: note_2 = ""
Case 5: note_1 = Oct_B * 12 + 1 + 16: note_2 = Oct_B * 12 + 1 + 17
Case 6: note_1 = Oct_B * 12 + 1 + 18: note_2 = Oct_B * 12 + 1 + 19
End Select
R_d(note_1) = White_key: C_d(note_1) = Start_C + KEY_C * C_n
Select Case note_2 = "": Case False:
R_d(note_2) = Black_key: C_d(note_2) = Start_C + KEY_C * C_n + 3
End Select:
Next C_n
For i = Start_Row + 7 To S_line Step 4
Set R_line = Range(Cells(i, 1), Cells(i, key_n * KEY_C))
With R_line.Borders(xlEdgeBottom): .LineStyle = xlDot: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With:
' S_line.Interior.Color = RGB(250, 250, 250)
For j = 36 To 96 ' MIDI note 番号
Select Case R_d(j)
Case White_key: Set C_line = Range(Cells(i + 1, C_d(j)), Cells(i + 1, C_d(j)))
With C_line.Borders(xlLeft): .LineStyle = xlContinuous: .TintAndShade = 0: .Weight = xlHairline: End With
Case Black_key: Set C_line = Cells(i, C_d(j) - 1)
' Set C_line = Range(Cells(Start_C + 7, C_d(j) - 1), Cells(S_line, C_d(j) - 1))
With C_line.Borders(xlLeft): .LineStyle = xlDot: .TintAndShade = 0: .Weight = xlThin: End With
End Select:
Next j
Next i
End Sub
'MIDI API
Private Declare PtrSafe Function midiOutGetNumDevs Lib "winmm" () As Integer
Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwflags As Long) As Long
Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
Dim Handle As LongPtr
'Sleep API
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
' PianoPlaying Flug
Dim PianoPlaying
Sub PIANO_Play()
'MIDI出力デバイス取得
Dim Ret As Long
Ret = midiOutGetNumDevs
Dim i As Long
Dim Msg As Long
Dim BaseMsg1 As Long
'MIDIデバイスを開く
If Ret = 0 Then
MsgBox "MIDI音源が無いため利用できません。"
Exit Sub
Else
Ret = midiOutOpen(Handle, -1, 0, 0, 0)
End If
' Msg = BaseMsg1 + &H0 * &H100: Call midiOutShortMsg(Handle, Msg) 'MIDIメッセージを送る(=音を鳴らす)
DoEvents: DoEvents:
' Sleep (3000)
Dim C_d(1 To 128) As Variant
Dim R_d(1 To 128) As Variant
' Call FormatCondition_Black_key
Start_C = 3
Start_Row = 1001
Start_Row = 1
Split_Row = 40
KEY_C = 4
' 音楽記号 ♪ ?????♪??
key_n = 52
Tempo_Def = 250 ' : ♪=240 =60*1000/240
T_p = InStr(Cells(5, 1), "=")
Select Case T_p:
Case Is > 0: Tempo = CLng(Mid(Cells(5, 1), T_p + 1)): Tempo_Def = 60000 / Tempo
End Select
SLeep_ms = Tempo_Def
For C_n = 0 To key_n
CB_n = C_n Mod 7
Oct_B = Int(C_n / 7) + 1
Select Case CB_n
Case 0: note_1 = Oct_B * 12 + 1 + 8: note_2 = Oct_B * 12 + 1 + 9
Case 1: note_1 = Oct_B * 12 + 1 + 10: note_2 = ""
Case 2: note_1 = Oct_B * 12 + 1 + 11: note_2 = Oct_B * 12 + 1 + 12
Case 3: note_1 = Oct_B * 12 + 1 + 13: note_2 = Oct_B * 12 + 1 + 14
Case 4: note_1 = Oct_B * 12 + 1 + 15: note_2 = ""
Case 5: note_1 = Oct_B * 12 + 1 + 16: note_2 = Oct_B * 12 + 1 + 17
Case 6: note_1 = Oct_B * 12 + 1 + 18: note_2 = Oct_B * 12 + 1 + 19
End Select
R_d(note_1) = 3: C_d(note_1) = Start_C + KEY_C * C_n
Select Case note_2 = "": Case False:
R_d(note_2) = 1: C_d(note_2) = Start_C + KEY_C * C_n + 3
End Select:
Next C_n
ActiveWindow.FreezePanes = False
Range("C6").Select
ActiveWindow.FreezePanes = True
Range("AM6").Select
velocity = 127 ' 音の強さ
channel = 1 ' channel
Timber = 1 '0:Acoustic Grand Piano :5 Electric Piano_ 1 25:Acoustic Guitar (nylon) 28: Electric Guitar (clean) 11:Music box
Call Change_Timber(Timber, channel)
R_MAX = Range("A20").CurrentRegion.Rows.Count
Select Case R_MAX: Case Is > 1500: R_MAX = 1500: Case Is > 20:: Case Else: R_MAX = 20: End Select
Range("AAM6").Select
Range("AM6").Select
For n = 5 + 1 To R_MAX
Loss = 0
' Select Case n Mod 4: Case 1: Range("C3:HC3").Interior.Color = RGB(200, 255, 255): Loss = Loss + 50: End Select
' Select Case n Mod 4: Case 0: Range("C1:HC1").Value = Empty: Loss = Loss + 50: End Select
T_p = InStr(Cells(n, 1), "=")
Select Case T_p:
Case Is > 0: Tempo = Val(Mid(Cells(n, 1), T_p + 1)): SLeep_ms = 60000 / Tempo
Case Else: SLeep_ms = Tempo_Def:
End Select
Timber_p = InStr(Cells(n, 2), "Timber=")
Select Case Timber_p:
Case Is > 0: Timber = Val(Mid(Cells(n, 2), Timber_p + 7)): Call Change_Timber(Timber, channel):
End Select
For c = 3 To 3 * 110
Set D_n = Cells(n, c): Set D_k = Range(Cells(3, c), Cells(3, c + 2)):
Select Case D_n.Value > 30
Case True:
Select Case D_n.Value: Case Is < 36: velocity = 100: Case Is < 60: velocity = 115: Case Else: velocity = 127:: End Select
note = D_n.Value: Msg = velocity * &H10000 + note * &H100 + &H90 + channel: Call midiOutShortMsg(Handle, Msg):
Loss = Loss + 2
' Call Hitkey(R_d(note), C_d(note), True):
End Select
Select Case D_n.Value < -30
Case True
note = Abs(D_n.Value): Msg = &H10000 + note * &H100 + &H80 + channel: Call midiOutShortMsg(Handle, Msg):
Loss = Loss + 2
' Call Hitkey(R_d(note), C_d(note), False):
End Select
Next c
DoEvents: DoEvents: Sleep (SLeep_ms - Loss)
ActiveWindow.ScrollRow = n
Select Case Range("B2"): Case "stop": Exit For: End Select
Next n
Range("C6").Select
'MIDIデバイスを閉じる
Ret = midiOutClose(Handle)
' MsgBox "正常に終了しました。"
End Sub
Private Sub Hitkey(R_d As Variant, C_d As Variant, ON_set As Boolean)
Select Case R_d: Case 3: Call Hitkey_C3(C_d, ON_set): Case 1: Call Hitkey_F1(C_d, ON_set): End Select:
End Sub
Private Sub Hitkey_C3(Column As Variant, ON_set As Boolean)
Select Case Column: Case 0: Exit Sub: End Select:
Set D = Cells(3, Column)
Select Case ON_set: Case True:
D.Interior.Color = RGB(0, 255, 255)
' With D.Interior: .Pattern = xlPatternRectangularGradient: .Gradient.RectangleLeft = 0.5: .Gradient.RectangleRight = 0.5: .Gradient.RectangleTop = 0.5: .Gradient.RectangleBottom = 0.5: .Gradient.ColorStops.Clear: End With
' With D.Interior.Gradient.ColorStops.Add(0): .ThemeColor = xlThemeColorDark1: .TintAndShade = 0: End With
' With D.Interior.Gradient.ColorStops.Add(1): .ThemeColor = xlThemeColorAccent1: .TintAndShade = 0: End With
Case False: D.Interior.Color = RGB(200, 255, 255)
End Select
End Sub
Private Sub Hitkey_F1(Column As Variant, ON_set As Boolean)
Select Case Column: Case 0: Exit Sub: End Select:
Set D = Cells(1, Column)
Select Case ON_set: Case True:
D.Value = 1
' With D.Interior: .Pattern = xlPatternRectangularGradient: .Gradient.RectangleLeft = 0.5: .Gradient.RectangleRight = 0.5: .Gradient.RectangleTop = 0.5: .Gradient.RectangleBottom = 0.5: .Gradient.ColorStops.Clear: End With
' With D.Interior.Gradient.ColorStops.Add(0): .ThemeColor = xlThemeColorDark1: .TintAndShade = 0: End With
' With D.Interior.Gradient.ColorStops.Add(1): .ThemeColor = xlThemeColorLight1: TintAndShade = 5.09659108249153E-02: End With
Case False: D.Interior.Color = RGB(0, 0, 0): D.Value = "":
End Select
End Sub
Private Sub FormatCondition_Black_key()
Start_C = 3: Start_Row = 1: Split_Row = 40: KEY_C = 4: key_n = 52:
Cells.FormatConditions.Delete
Set KEY_D = Range(Cells(Start_Row, Start_C), Cells(Start_Row, Start_C + KEY_C * key_n + KEY_C - 1))
KEY_D.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=0"
KEY_D.FormatConditions(1).Interior.Color = RGB(200, 150, 150):
KEY_D.FormatConditions(1).Font.Color = RGB(200, 150, 150):
End Sub
Private Sub Change_Timber(Timber, channel)
Dim Msg As Long
Msg = Timber * &H100 + &HC0 + channel:
Call midiOutShortMsg(Handle, Msg):
End Sub
Sub PIANO_key()
Dim note As Variant
Dim Ret As Long
Dim i As Long
Dim Msg As Long
Dim BaseMsg1 As Long
note = ActiveCell.Value
note_p = InStr(note, vbLf):
Select Case note_p: Case Is > 0: note = Val(Mid(note, note_p + 1)): End Select
Select Case note
Case Is > 111: Exit Sub:
Case Is < 21: Exit Sub:
Case Is > 20:
Ret = midiOutGetNumDevs
Select Case Ret:
Case 0: MsgBox "MIDI音源が無いため利用できません。": Exit Sub:
Case Else: Ret = midiOutOpen(Handle, -1, 0, 0, 0)
End Select
Case Else: Exit Sub:
End Select
For i = 1 To 2
velocity = 127 ' 音の強さ
channel = 1 '
Msg = velocity * &H10000 + note * &H100 + &H90 + channel:
Call midiOutShortMsg(Handle, Msg):
Sleep (2000)
Next i
Msg = velocity * &H10000 + note * &H100 + &H80 + channel:
Call midiOutShortMsg(Handle, Msg):
DoEvents: DoEvents:
Ret = midiOutClose(Handle)
End Sub
test2 PIANO
'MIDI API
Private Declare PtrSafe Function midiOutGetNumDevs Lib "winmm" () As Integer
Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwflags As Long) As Long
Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
Dim Handle As LongPtr
'Sleep API
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
'SheetSelectionChange event
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Call PIANO_hit_key
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False:
Application.CommandBars("Cell").Reset '初期化
End Sub
'Cell CommandBer
Private Sub Workbook_Open()
Application.CommandBars("Cell").Reset '初期化
Set Ctrl1 = Application.CommandBars("Cell").Controls.Add: Ctrl1.Caption = "●PIANO 音 テスト": Ctrl1.OnAction = "PIANO_key"
End Sub
'PIANO keyNumber select action
Private Sub PIANO_hit_key()
Dim note As Variant
Dim Ret As Long
Dim i As Long
Dim Msg As Long
Dim BaseMsg1 As Long
note = ActiveCell.Value
note_p = InStr(note, vbLf):
Select Case note_p: Case Is > 0: note = Val(Mid(note, note_p + 1)): End Select
Select Case note
Case Is > 111: Exit Sub: Case Is < 21: Exit Sub: Case Is > 20:
Ret = midiOutGetNumDevs
Select Case Ret: Case 0: MsgBox "MIDI音源が無いため利用できません。": Exit Sub:
Case Else: Ret = midiOutOpen(Handle, -1, 0, 0, 0)
End Select
Case Else: Exit Sub:
End Select
velocity = 20 ' 音の強さ
channel = 1 '
Msg = velocity * &H10000 + note * &H100 + &H90 + channel:
Call midiOutShortMsg(Handle, Msg):
Sleep (200)
velocity = 127 ' 音の強さ
Msg = velocity * &H10000 + note * &H100 + &H90 + channel:
Call midiOutShortMsg(Handle, Msg):
Sleep (900)
Msg = velocity * &H10000 + note * &H100 + &H80 + channel:
Call midiOutShortMsg(Handle, Msg):
Ret = midiOutClose(Handle)
End Sub
令和6年４月２４日 御神木伐採後の跡片付けを行います。
参加いただける方は三島神社境内に集合してください。
３月末に２日がかりで行った御神木伐採はほぼ予定通り進めることができました。
ご協力いただいた方々に感謝いたします。
令和６年４月8日
【三島神社】氏子連絡網 のチャット招待を始めます。
匿名で参加でき、個人のアカウントを公開したくない方も参加できます。
- 初めての方は次のガイドを参照してください。
- 【三島神社】氏子連絡網 に招待します。下記のリンクをクリックして、任意のプロファイルで参加してください。
三島神社 氏子スケジュールを登録したカレンダーを表示します.
クリックしてください
【Safari】Googleカレンダーが表示されない場合の対処方法
iPhoneの標準ブラウザ「Safari」にて、 iOSのバージョンを15.2以降にアップデートすると、ブラウザ「Safari」が「サイト越えトラッキングを防ぐ」という仕組みを強制的に「オン」にしてしまうため、Googleカレンダーを正常に表示できないケースが発生します。
【対応方法】 Safariの「サイト越えトラッキングを防ぐ」設定をオフにする。
【設定をオフにする手順】
- ホーム画面から「設定」を選択する。
- アプリ一覧から「Safari」を選択する。
- プライバシーとセキュリティにある「サイト越えトラッキングを防ぐ」をオフにする。
お手数をおかけしますが、何卒よろしくお願いいたします。
ホームページに三島神社＿氏子スケジュールを追加しました。
令和６年３月３０日～３１日
朝から氏子総代・協力者・プロが集合し樹木伐採を行いました。
三島神社の樹木🌲🌲伐採を行います。
令和6年3月30日〜31日の2日間で、樹木の伐採作業を行います。氏子関係者のご協力をお願いします。協力いただける方は、三島神社境内に集まってください。