엑셀에서 두 매크로를 동시에 적용시키는 방법은? Sub ApplyCellColorsToShapes()

Sub ApplyCellColorsToShapes(Optional ByVal columnNumbers As String = "1,3")

Dim sourceSheet As Worksheet

Dim targetSheet As Worksheet

Dim sourceCell As Range

Dim shapeName As String

Dim cellColor As Long

Dim i As Integer, j As Integer

Dim shapeCount As Integer

Dim colArray() As String

Dim currentColumn As Integer

​

' 시트 설정

Set sourceSheet = ThisWorkbook.Sheets("Sheet1")

Set targetSheet = ThisWorkbook.Sheets("Sheet2")

​

' 열 번호 파싱

colArray = Split(columnNumbers, ",")

' 도형 개수 확인

shapeCount = targetSheet.Shapes.Count

' 모든 지정된 열에 대해 처리

For j = LBound(colArray) To UBound(colArray)

currentColumn = CInt(Trim(colArray(j)))

' 각 도형에 대해 처리

For i = 1 To 120

If i > shapeCount Then Exit For

' 도형 이름 생성

shapeName = "Rectangle" & Format(i, "00")

' 소스 셀 설정

Set sourceCell = sourceSheet.Cells(i, currentColumn)

On Error Resume Next

' 도형이 존재하는지 확인

If Not targetSheet.Shapes(shapeName) Is Nothing Then

' 셀 색상 가져오기

cellColor = sourceCell.DisplayFormat.Interior.Color

' 도형에 색상 적용

targetSheet.Shapes(shapeName).Fill.ForeColor.RGB = cellColor

Else

Debug.Print "도형 " & shapeName & "이(가) 존재하지 않습니다."

End If

On Error GoTo 0

Next i

Next j

MsgBox "모든 도형 색상이 성공적으로 적용되었습니다.", vbInformation

End Sub