VBA 斜線

斜線を引く

Sub zsDrawDiagonalLine()
    Dim ws1 As Worksheet
    Dim tRng As Range
    Dim allRng As Range
    Dim i As Long, j As Long, k As Long
    Set ws1 = Worksheets("data1")
    With ws1
        Set allRng = .Range("A2:G30")
        allRng.Borders(xlDiagonalUp).Weight = xlThin
    End With
End Sub
Sub test01()
    Dim ws1 As Worksheet
    Dim rngStr As String
    rngStr = "A2:G30"
    Set ws1 = Worksheets("data1")
    Call zfDrawDiagonalLine(ws1, rngStr)
End Sub

Function zfDrawDiagonalLine(ByRef ws As Worksheet, ByVal rngSrr As String)
    Dim i As Long, j As Long, k As Long
    Dim allRng As Range
    Set allRng = ws.Range(rngSrr)
    allRng.Borders(xlDiagonalUp).Weight = xlThin
End Function

空白と0のセルだけに斜線を引く

Sub zsDrawBlankDiagonalLine()
    Dim ws1 As Worksheet
    Dim tRng As Range
    Dim allRng As Range
    Dim i As Long, j As Long, k As Long
    Set ws1 = Worksheets("data1")
    With ws1
        Set allRng = .Range("A2:G30")
        For i = 1 To allRng.Rows.Count
            For j = 1 To allRng.Columns.Count
                If allRng(i, j) = "" Or allRng(i, j) = 0 Then
                    .Range(allRng(i, j).Address).Borders(xlDiagonalUp).Weight = xlThin
                End If
            Next j
        Next i
    End With
End Sub
Sub test03()
    Dim ws1 As Worksheet
    Dim rngStr As String
    Set ws1 = Worksheets("data1")
    rngStr = "A2:G30"
    Call zfDrawBlankDiagonalLine(ws1, rngStr)
End Sub

Sub zfDrawBlankDiagonalLine(ByRef ws As Worksheet, ByVal rngSrr As String)
    Dim allRng As Range
    Dim i As Long, j As Long, k As Long
    With ws
        Set allRng = .Range(rngSrr)
        For i = 1 To allRng.Rows.Count
            For j = 1 To allRng.Columns.Count
                If allRng(i, j) = "" Or allRng(i, j) = 0 Then
                    .Range(allRng(i, j).Address).Borders(xlDiagonalUp).Weight = xlThin
                End If
            Next j
        Next i
    End With
End Sub

斜線を消す

Sub zsDelDiagonalLine()
    Dim ws1 As Worksheet
    Dim tRng As Range
    Dim allRng As Range
    Dim i As Long, j As Long, k As Long
    Set ws1 = Worksheets("data1")
    With ws1
        Set allRng = .Range("A2:G30")
        allRng.Borders(xlDiagonalUp).LineStyle = xlNone
    End With
End Sub
Sub test02()
    Dim ws1 As Worksheet
    Dim rngStr As String
    Set ws1 = Worksheets("data1")
    rngStr = "A2:G30"
    Call zfDelDiagonalLine(ws1, rngStr)
End Sub

Function zfDelDiagonalLine(ByRef ws As Worksheet, ByVal rngSrr As String)
    Dim i As Long, j As Long, k As Long
    Dim allRng As Range
    Set allRng = ws.Range(rngSrr)
    allRng.Borders(xlDiagonalUp).LineStyle = xlNone
End Function

コメント