엑셀 shape의 텍스트(text)를 셀에 자동으로 추출하기(vb활용)

 

안녕하세요.

 

오랫만에 포스팅 합니다.

 

오늘은 엑셀 VB를 활용하여

 

SHAPE객체의 텍스트를 셀로 추출 하는 매크로를 만들어 보려고 합니다.

 

활용도는 글쎄요...

 

혹시나 필요하신분들이 있을까 몰라 올립니다.

먼저 위와 같은 셰이프 텍스트 박스가 있다면

개발도구 -> 삽입 -> 양식컨트롤 -> 단추를 클릭하여 버튼을 추가해줍니다.

 

버튼의이름을 코드추출이라고 변경합니다.

개발도구를 클릭하여 VisualBasic를클 릭하여 다음과 이 코딩합니다.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

Option Explicit   Sub code_extraction()     Columns("O:P").Select ' O,P열 선택     Selection.ClearContents 'O,P열 삭제          Dim shp As Shape '각 도형을 넣을 변수     Dim varTemp '도형의 값을 Enter로 나누어 넣을 배열변수     Dim i As Long '배열 개수만큼 반복할 변수     Dim s As Long '각 배열내 숫자만큼 반복할 변수     Dim strL As String '각 배열의 각 숫자를 넣을 변수     Dim strU As String '각 숫자를 합쳐 넣을 변수         '화면 업데이트 (일시)정지     Application.ScreenUpdating = False       '현재시트의 각 도형을 순환     For Each shp In ActiveSheet.Shapes         If shp.Type = 1 Then '만약 도형의 (자동생성)도형 종류라면                         Cells(Rows.Count, "o").End(3)(2) = shp.Name 'Q열에 도형의 이름을 넣음             varTemp = Split(shp.TextFrame2.TextRange.Text) 'shape의 텍스트를 한글자로 분리             For i = 0 To UBound(varTemp) '배열 개수만큼 반복                 For s = 1 To Len(varTemp(i)) '각 배열의 문자길이 만큼 반복                     strL = Mid(varTemp(i), s, 1) '각 문자를 변수에 넣음                     strU = strU & strL '각 문자 숫자를 합쳐감                 Next s                                  '합쳐진 문자를 줄바꿈(alt+enter)를 제거하고 S열에 뿌려줌                 Cells(Rows.Count, i + 16).End(3)(2) = Replace(strU, vbLf, "")                                  strU = ""                                        '재사용 위하여 초기화                              Next i                  End If     Next shp End Sub

소스가 조금 복잡하더라도 주석이 있어 이해하기 쉬울 겁니다.

위와 같이 버튼에 우클릭하여 매크로 지정을 클릭합니다.

 

code_extration매크로를 코드추출 버튼에 지정합니다.

 

짜잔 그럼 아래와 같이 shape넘버와 텍스트를 가져와 O열과 P열에 각각 추출합니다

 

뭔가 간단할거 같아 시작 하였지만

 

엑셀 VB만들고보니 좀더 공부를 해야겠다고 생각이 들었습니다.

 

즐거운 하루 되세요.