VBA로 메모 일괄 처리하기

관련: 지식인

 

특정 단어에 대해 메모를 일괄로 삽입하려면 VBA를 한 번 이용해보세요.

​

Alt-F11 누르고 삽입 > 모듈 추가 후에

아래 코드를 붙여 넣으세요.

 

아래 경우는 모든 슬라이드에서 '비디오'라는 문자를 찾아서 '비디오'라는 글자 우측 상단에 메모를 추가합니다.

Option Explicit

Sub AddMemo()

    Dim sld As Slide
    Dim shp As Shape
    Dim tr As TextRange, cmt As Comment
    Dim pos As Long, Rmargin As Single, Tmargin As Single
    Dim strSearch$, Author$, Memo$, strUser$, tmp() As String
    
    '// 슬라이드에서 '비디오'라는 문자를 찾아서 우측 상단에 메모를 추가합니다.
    strSearch = "비디오"  '"비디오"    '찾을 문자열
    Author = "홍길동"
    Memo = "메모내용입니다."
    
    If strSearch = "" Then
        strUser = InputBox("찾을 문자열, 작성자, 메모내용을 콤마로 구분해서 입력하세요.", "메모일괄추가", strSearch & ", " & Author & ", " & Memo)
        If strUser = "" Then MsgBox "취소합니다.": Exit Sub
        tmp = Split(strUser, ",")
        If UBound(tmp) < 2 Then MsgBox "찾을 문자열, 작성자, 메모내용을 콤마로 구분해 입력하세요.": Exit Sub
        strSearch = Trim(tmp(0)): Author = Trim(tmp(1)): Memo = Trim(tmp(2))
    End If
    'Debug.Print strSearch & ", " & Author & ", " & Memo
    
    Rmargin = -5: Tmargin = -10
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    pos = 0
                    Do
                        Set tr = shp.TextFrame.TextRange.Find(FindWhat:=strSearch, After:=pos, _
                            MatchCase:=msoFalse, WholeWords:=msoFalse)
                        If Not tr Is Nothing Then
                            Set cmt = sld.Comments.Add(tr.BoundLeft + tr.BoundWidth + Rmargin, tr.BoundTop - Tmargin, _
                                Author, "", Memo)
                            pos = tr.Start + Len(strSearch)
                        End If
                         
                    Loop While Not tr Is Nothing
                
                End If
            End If
        Next shp
    Next sld
    
End Sub

찾을 문자열과​ 작성자와 메모 내용은 알맞게 고치세요.

코드를 조금 더 수정해서 찾을 문자열과 작성자, 일괄메모내용을 콤마로 구분해서 입력하도록 했습니다.

​

이제 F5를 누르거나 코드창을 닫고 Alt-F8로 AddMemo 매크로를 실행하세요.

​

아래처럼 홍길동이라는 작성자 이름으로 '비디오'라는 글자 마다 메모를 모두 삽입해줍니다.

코드상의 메모내용 뒤에 & " " & pos 는삭제하세요.

 

​

위 작업은 모든 슬라이드를 대상으로 처리합니다.

​

참고로 아래 코드는 특정 작성자의 메모를 모두 삭제해줍니다. 

Sub DeleteMemoByAuthor()
    Dim sld As Slide
    Dim shp As Shape
    Dim l As Long, Author As String
    
    Author = "홍길동"
    For Each sld In ActivePresentation.Slides
        For l = sld.Comments.Count To 1 Step -1
            If sld.Comments(l).Author = Author Then sld.Comments(l).Delete
        Next l
    Next sld
End Sub

 

아래 코드는 모든 슬라이드의 메모를 Ctrl-G실행창에 출력해줍니다.

Sub ListMemos()
    Dim sld As Slide
    Dim shp As Shape
    Dim l As Long
    
    For Each sld In ActivePresentation.Slides
        With sld.Comments
        For l = .Count To 1 Step -1
            Debug.Print "************************* " & sld.SlideIndex & " Slide - " & l
            Debug.Print "Author: " & .Item(l).Author
            Debug.Print "DateTime: " & .Item(l).DateTime
            Debug.Print "Text:" & .Item(l).Text
            Debug.Print "x,y: " & .Item(l).Left & ", " & .Item(l).Top
            Debug.Print "**************************" & vbCrLf
        Next l
        End With
    Next sld
End Sub

Ctrl-G창 출력결과

 

첨부파일 참고하세요.

AddMemo1.pptm

0.06MB

AddMemo2.pptm

0.06MB