엑셀에서 취소선 대신 화살표 등 도형 표시

 

관련: 지식인

 

엑셀에서 셀 내의 글자에 취소선을 적용할 수 있습니다.

그런데 단순한 직선 대신 화살표 모양 취소선을 표시하고 싶은 경우입니다.

 

 

 

 

엑셀에서 따로 취소선의 서식을 지원하지 않으므로

VBA를 이용해서 직접 그려줘야겠습니다.

​

아래 VBA를 이용하면 선택된 셀에 텍스트에 취소선 화살표를 그려줍니다.

화살표 모양이나 색상, 굵기 등은 코드를 수정하면 됩니다.

텍스트인경우 왼쪽 정렬해서 글자 위에 그려줍니다.

 

문제가 하나 있습니다.

사실, 엑셀의 텍스트로는 글자의 X/Y위치값을 알 수 없습니다.

 

단순하게 셀 크기 만큼의 크기로 직선을 그으면 되지만 취소선과 같은 모양으로 만들려면

텍스트의 시작이나 마지막의 X/Y좌표를 알 수 없어 직선을 그리는데 어려움이 있습니다.

 

파워포인트의 텍스트상자나 도형은 내부 텍스트의 Character의 X/Y좌표를 알 수 있지만

엑셀에서는 이 기능을 제공하지 않습니다.

파워포인트 개체로 만들어서 복사해올 수는 있겠으나 너무 번거롭습니다.

 

그래서 여기서는 

엑셀 시트상에 임시로 텍스트 상자를 그려봐서 그 위치를 통해 화살표를 그리도록 했습니다.

​

그렇기 때문에 간단한 것 같지만 코드가 길어졌습니다.

 

Sub addStrikeThrough()

    Dim rng As Range, sht As Worksheet
    Dim shp As Shape, shpT As Shape
    Dim x1!, x2!, y!, m!
    
    Set sht = ActiveSheet
    If ActiveWindow.Selection Is Nothing Then Exit Sub

    For Each rng In ActiveWindow.Selection
        
        '임시 텍스트상자 그리기
        Set shp = sht.Shapes.AddTextbox(msoTextOrientationHorizontal, rng.Left, rng.Top, rng.Width, rng.Height)
        With shp.TextFrame
            .HorizontalAlignment = rng.HorizontalAlignment
            .VerticalAlignment = rng.VerticalAlignment
            .Characters.Text = rng.Text
            .Characters.Font.Size = rng.Font.Size
            .Characters.Font.Name = rng.Font.Name
            .MarginLeft = 0:    .MarginRight = 0
            .MarginTop = 0:     .MarginBottom = 0
            .AutoSize = True
        End With
        DoEvents
        m = 2   '여백
        x1 = shp.Left
        x2 = shp.Left + shp.Width + m
        If rng.HorizontalAlignment = xlGeneral Then '데이터유형에 따른 일반정렬인 경우
            If IsNumeric(rng.Text) Then
                x1 = x1 + (rng.Width - shp.Width) - m
                x2 = x1 + shp.Width + m
            End If
        End If
        y = shp.Top + shp.Height / 2
        shp.Delete
        
        '화살표 그리기
        'y = rng.Top + rng.Height / 2
        'x1 = rng.Left + m
        'x2 = rng.Left + rng.Width - m * 2
        Set shp = sht.Shapes.AddLine(x1, y, x2, y)
        With shp.Line
            .Weight = 1
            .ForeColor.RGB = rgbTeal
            .EndArrowheadStyle = msoArrowheadTriangle
            .EndArrowheadLength = msoArrowheadLong
            .EndArrowheadWidth = msoArrowheadWide
        End With
        shp.Name = "ST_" & rng.Address(False, False)
        shp.Placement = xlMove
        
    Next rng

End Sub

 

 

위 매크로를 빠른 실행에 추가하면 단축키로 실행 가능합니다.

​

셀을 선택하고 Alt+F8등으로 매크로 addStrikeThrough를 실행하면 화살표를 추가하고

아래의 delStrikeThrough 를 실행하면 선택된 셀 위의 화살표를 지워줍니다.

 

Sub delStrikeThrough()
    
    Dim sht As Worksheet
    Dim rng As Range
    Dim l As Long, shp As Shape
    
    Set sht = ActiveSheet
    For l = sht.Shapes.Count To 1 Step -1
        Set shp = sht.Shapes(l)
        If shp.Name Like "ST_*" Then
            For Each rng In ActiveWindow.Selection
                If shp.TopLeftCell.Address = rng.Address Then
                    shp.Delete
                    Exit For
                End If
            Next rng
        End If
    Next l
End Sub

 

 

​실행화면:

 

취소선의 서식은 코드의 아래 부분을 수정하세요.

선의 두께, 색상, 시작/끝 화살표의 모양/길이/폭 등을 수정할 수 있습니다.

도형이므로 그림자, 반사, 네온, 3차원효과 등 도형효과도 적용 가능합니다.

        With shp.Line
            .Weight = 1
            .ForeColor.RGB = rgbTeal
            .EndArrowheadStyle = msoArrowheadTriangle
            .EndArrowheadLength = msoArrowheadLong
            .EndArrowheadWidth = msoArrowheadWide
        End With

 

 

테스트는 첨부파일 참고하세요.

 

통합 문서1.xlsm

0.02MB