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
0コメント