斜線を引く
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
コメント