'　★いちりのテック★
' https://ichiri.biz/tech/fpga-timing-char/
'(1) This macro is for Excel.  I tested with Excel2016.
'　　Use this macro as your responsibility.
'
'(2) Copy all contents in this file in a module under PERSONAL.XLSB.
'  　File location:　C:\Users\<<folder of login user name>>\AppData\Roaming\Microsoft\Excel\XLSTART
'
'(3) I am using shortcut keys which are not used frequently and avoided from using frequently used shortcut keys.
'　　You have to allocate shortcut keys after you pasted the below code.
'　　Time chart lines are drawn as border(Keisen in Japanese) except for dotted line as cursor.
'　　[1] Generate grid for signal: Ctrl+J
'　　[2] Clock          :Ctrl+K -- 2x4 cells -- Sub clock()
'　　[3] Clock1/2       :Ctrl+Shift+K -- 2x2 cells -- Sub clock_1_2()
'　　[4] Rising edge    :Ctrl+R -- 2x1 cells -- Sub rising_edge()
'　　[5] Falling edge   :Ctrl+T -- 2x1 cells -- Sub falling_edge()
'　　[6] Data start     :Ctrl+Y -- 2x1 cells -- Sub data_in()
'　　[7] Data end       :Ctrl+E -- 2x1 cells -- Sub data_end()
'　　[8] Data hold      :Ctrl+W -- 2x1 cells -- Sub data_hold()
'　　[9] Low signal     :Ctrl+L -- 2x1 cells -- Sub low_signal()
'　　[10] High signal   :Ctrl+Q -- 2x1 cells -- Sub high_signal()
'　　[11] Vertical dotted line   :Ctrl+M -- Draws -50points to +150points from the position of the cursor.
'　　[12]€ Vertical up   :Ctrl+Shift+R -- from 1x1 to nx1 cells -- Sub border_vertical_up()
'　　[13] Vertical down :Ctrl+Shift+T -- from 1x1 to nx1 cells -- Sub border_vertical_down()
'　　[14] Horizontal low:Ctrl+Shift+L -- from 1x1 to 1xn cells -- Sub border_horizontal_low()
'　　[15] Erase all     :Ctrl+Shift+E -- from 1x1 to mxn cells -- from Sub border_all_erase()
'　　[16] Cursor dash arrow :Ctrl+Shift+M from Sub cursor_dash_arrow()


'Declaration to find the cursor position on Excel sheet.
'Decleration for both 32bit and 64bit Windows OS.
Type x_y
    x As Single
    y As Single
End Type
#If Win64 Then    
'   LongをLongPtrに変更(20221212)
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As Coordinate) As LongPtr
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As Coordinate) As LongPtr
#Else
    Private Declare Function GetCursorPos Lib "User32" (lpPoint As coordinate) As Long
#End If

Sub clock()
' clock Macro
' Keyboard Shortcut: Ctrl+k
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
        ActiveCell.Offset(1, 0).Activate
    End If

    ActiveCell.Offset(-1, 0).Activate
    Selection.Resize(1, 1).Select

    Selection.Resize(2, 2).Select
    Call border(xlEdgeLeft)
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    ActiveCell.Offset(0, 2).Activate
    Selection.Resize(2, 2).Select
    Call border(xlEdgeLeft)
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveCell.Offset(1, 2).Activate

End Sub
Sub clock_half()
' clock half Macro
' Keyboard Shortcut: Ctrl+shift+k
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
        ActiveCell.Offset(1, 0).Activate
    End If

    ActiveCell.Offset(-1, 0).Activate
    Selection.Resize(2, 1).Select

    Call border(xlEdgeLeft)
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    ActiveCell.Offset(1, 1).Activate
    Call border(xlEdgeLeft)
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveCell.Offset(0, 1).Activate
End Sub
Sub rising_edge()
' rising_edge Macro
' Keyboard Shortcut: Ctrl+r
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
        ActiveCell.Offset(1, 0).Activate
    End If
    
    ActiveCell.Offset(-1, 0).Activate
    Selection.Resize(2, 1).Select

'    Call cell_merge
    Selection.MergeCells = True
    Call border(xlDiagonalUp)
    Selection.Resize(1, 1).Select

'Selection.Resize(1,1)
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Offset(1, 0).Activate
    
End Sub
Sub falling_edge()
' Falling_edge Macro
' Keyboard Shortcut: Ctrl+f
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
        ActiveCell.Offset(1, 0).Activate
    End If

    ActiveCell.Offset(-1, 0).Activate
    Selection.Resize(2, 1).Select
'    Call cell_merge
    Selection.MergeCells = True
    Call border(xlDiagonalDown)
    Selection.Resize(1, 1).Select
    
'Selection.Resize(1,1)
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Offset(1, 0).Activate

End Sub
Sub data_in()
' data_in Macro
' Keyboard Shortcut: Ctrl+y
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
        ActiveCell.Offset(1, 0).Activate
    End If
    Call border(xlDiagonalDown)
    ActiveCell.Offset(-1, 0).Activate
    'Selection.Resize is added or macro command doesn't work properly.
    Selection.Resize(1, 1).Select
    Call border(xlDiagonalUp)
    ActiveCell.Offset(1, 1).Activate
End Sub
Sub data_end()
' data_end Macro
' Keyboard Shortcut: Ctrl+e
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
        'Selection.Resize is added or macro command doesn't work properly.
        Selection.Resize(1, 1).Select
        ActiveCell.Offset(1, 0).Activate
    End If
    Call border(xlDiagonalUp)
    ActiveCell.Offset(-1, 0).Activate
    Call border(xlDiagonalDown)
    ActiveCell.Offset(1, 1).Activate
End Sub
Sub data_hold()
' data_hold Macro
' Keyboard Shortcut: Ctrl+w
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Selection.MergeCells = False
    Else
        ActiveCell.Offset(-1, 0).Activate
    End If
    Selection.Resize(2, 1).Select
    Call border_top_bottom
    ActiveCell.Offset(1, 1).Activate
End Sub
Sub low_signal()
' low_signal Macro
' Keyboard Shortcut: Ctrl+l
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Call border(xlEdgeBottom)
        Selection.MergeCells = False
        ActiveCell.Offset(1, 1).Activate
    Else
        Call border(xlEdgeBottom)
        ActiveCell.Offset(0, 1).Activate
    End If
End Sub
Sub high_signal()
' high_signal Macro
' Keyboard Shortcut: Ctrl+q
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    If Selection.MergeCells Then
        Call border_none
        Selection.MergeCells = False
    Else
        ActiveCell.Offset(-1, 0).Activate
    End If
    Selection.Resize(1, 1).Select
    Call border(xlEdgeTop)
    ActiveCell.Offset(1, 1).Activate
End Sub
Sub border_vertical_up()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = tc_color
        .Weight = xlThin
    End With
    ActiveCell.Offset(-1, 0).Activate
End Sub
Function tc_color() As Integer
  If (Range("A1") <> "") Then
    tc_color = vbRed
  Else
    tc_color = vbBlack
  End If
End Function
Sub border_vertical_down()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    ActiveCell.Offset(1, 0).Activate
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = tc_color
        .Weight = xlThin
    End With
End Sub
Sub border_horizontal_low()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = tc_color
        .Weight = xlThin
    End With
    If Selection.MergeCells Then
        ActiveCell.Offset(1, 1).Activate
    Else
        ActiveCell.Offset(0, 1).Activate
    End If
End Sub
Sub border_all_erase()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    Call border_none
    Selection.MergeCells = False
End Sub
Sub border(edge)
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    Call border_none
    With Selection.Borders(edge)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
Sub border_top_bottom()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
'    Call border_none
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = tc_color
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
Sub border_none()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Sub cell_merge()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
End Sub
Sub cell_for_signals()
' cell_for_signals Macro
' Keyboard Shortcut: Ctrl+Shift+j
'
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
    Dim cell_size As Single
    
'    Sheets.Add
    cell_size = Application.InputBox("Enter the hight of grid." & vbCrLf & "Use only number of single-byte character." & vbCrLf & "Enter from 3.0 to 20.0. Or the default 5 is used.", "Grid size configuration", 5)
    If (VarType(cell_size) = vbSingle) And (cell_size >= 3) And (cell_size <= 20) Then
        Cells.Select
        Selection.ColumnWidth = cell_size * 0.1
        Selection.RowHeight = cell_size
    Else
        If (cell_size <> False) Then
            MsgBox "Enter only number of single-byte-charactor." & vbCrLf & " RANGE: 3.0 to 20.0", vbExclamation
        End If
    End If
End Sub
Sub cursor_dash()
' cursor_dash Macro
' Keyboard Shortcut: Ctrl+m

    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                    getExcelCusorPos.x, _
                                    getExcelCusorPos.y - 20, _
                                    getExcelCusorPos.x, _
                                    getExcelCusorPos.y + 100).Select
    
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .DashStyle = msoLineDash
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.5
        .Transparency = 0
    End With
    
End Sub
Function getExcelCusorPos() As x_y
Dim c As coordinate
Dim x1 As Long, y1 As Long
Dim x2 As Long, y2 As Long
   
   Call GetCursorPos(c)
    y1 = ActiveWindow.PointsToScreenPixelsY((ActiveWindow.VisibleRange.Range("A1").Top) * 96 / 72)
    x1 = ActiveWindow.PointsToScreenPixelsX((ActiveWindow.VisibleRange.Range("A1").Left) * 96 / 72)
    y2 = (c.y - y1) * 72 / 96 + ActiveWindow.VisibleRange.Range("A1").Top
    x2 = (c.x - x1) * 72 / 96 + ActiveWindow.VisibleRange.Range("A1").Left

    getExcelCusorPos.x = CSng(x2) / (ActiveWindow.Zoom / 100)
    getExcelCusorPos.y = CSng(y2) / (ActiveWindow.Zoom / 100)
    
End Function
Sub cursor_dash_arrow()
' cursor_dotted_arrow Macro
' Keyboard Shortcut: Ctrl+Shift+M

    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, getExcelCusorPos.x, _
        getExcelCusorPos.y, getExcelCusorPos.x + 80, getExcelCusorPos.y).Select
        
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .DashStyle = msoLineDash
        .BeginArrowheadStyle = msoArrowheadOpen
        .BeginArrowheadLength = msoArrowheadLengthMedium
        .BeginArrowheadWidth = msoArrowheadNarrow
        .EndArrowheadStyle = msoArrowheadOpen
        .EndArrowheadLength = msoArrowheadLengthMedium
        .EndArrowheadWidth = msoArrowheadNarrow
    End With

    ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, getExcelCusorPos.x + 20, _
        getExcelCusorPos.y + 2, 48, 72).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "tLOW" & vbCrLf & "20ns"
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(2, 4).Font.BaselineOffset = -0.25
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(8, 2).Font.BaselineOffset = -0.25

End Sub