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") = "♪/2=500": End Select
Range("A1") = "Start_P=": 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.9
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/標準"
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
S_Line = R_MAX
' Application.ScreenUpdating = False
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
Set KEYBOAD = Nothing:
Application.ScreenUpdating = True
' Call FormatConditionMacro
Call WorkArea_Line(S_Line)
ActiveWindow.FreezePanes = False
Range("C6").Select
ActiveWindow.FreezePanes = True
Range("W6").Select
ActiveWindow.ScrollColumn = 23
End Sub
Sub MM_FormatCondition_Line(Optional S_Line)
Select Case IsMissing(S_Line): Case True: S_Line = 1000: End Select
' Call WorkArea_Line_Clear(S_Line)
Cells.FormatConditions.Delete
Set M_Line = Range(Rows(6), Rows(S_Line + 10))
M_Line.RowHeight = 15
M_Line.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(COLUMN(),4)=1"
M_Line.FormatConditions(M_Line.FormatConditions.Count).SetFirstPriority
With M_Line.FormatConditions(1).Borders(xlLeft): .LineStyle = xlDashDot: .Weight = xlThin: .Color = RGB(150, 100, 100): End With
M_Line.FormatConditions(1).StopIfTrue = False
Range("EY14").Activate
M_Line.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(COLUMN(),4)=3"
M_Line.FormatConditions(M_Line.FormatConditions.Count).SetFirstPriority
With M_Line.FormatConditions(1).Borders(xlLeft): .LineStyle = xlDashDotDot: .Weight = xlThin: .Color = RGB(0, 150, 150): End With
M_Line.FormatConditions(1).StopIfTrue = False
M_Line.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),4)=3"
M_Line.FormatConditions(M_Line.FormatConditions.Count).SetFirstPriority
With M_Line.FormatConditions(1).Borders(xlBottom): .LineStyle = xlContinuous: .Weight = xlThin: .Color = RGB(150, 100, 100): End With
M_Line.FormatConditions(1).StopIfTrue = False
M_Line.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),4)=1"
M_Line.FormatConditions(M_Line.FormatConditions.Count).SetFirstPriority
With M_Line.FormatConditions(1).Borders(xlBottom): .LineStyle = xlDashDot: .Weight = xlThin: .Color = RGB(200, 100, 100): End With
M_Line.FormatConditions(1).StopIfTrue = False
Set M_Line = Nothing
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_D = Nothing
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)
Set KEY_D1 = Nothing
End Sub
Sub WorkArea_Line(Optional ByRef S_Line As Variant)
Select Case IsMissing(S_Line): Case True: S_Line = 1000: End Select:
START_C = 3: Start_Row = 1: Split_Row = 40: KEY_C = 4: key_n = 52: O_line = 50 'S_Line = 5000: O_line = 550:
Call WorkArea_Line_Clear(S_Line)
Set TEMPO = Range(Cells(Start_Row + 5, 1), Cells(O_line, 1))
For Each Rng In TEMPO
Select Case Rng.Value: Case Empty: Rng.Value = "♪/2": End Select:
Next:
Set TEMPO = Nothing
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
Call MM_FormatCondition_Line(S_Line)
End Sub
Sub WorkArea_Line_Clear(Optional ByRef S_Line As Variant)
Select Case IsMissing(S_Line): Case True: S_Line = 1000: End Select:
START_C = 3: Start_Row = 1: Split_Row = 40: KEY_C = 4: key_n = 52: 'S_Line = 5000: O_line = 550:
Set WorkArea = Range(Rows(START_C + 2), 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 WorkArea = Nothing
End Sub
0コメント