자작 프로그램입니다. (chatGPT가 90% 이상 작성한 것 같습니다 ㅎㅎ)
영어지문 암기에 활용하기 위해 문장배열을 구입하거나 직접 만드시는데,
문장배열을 만드는 데 많은 노력과 삽질이 필요합니다ㅠ.ㅠ
조금이나마 수고를 덜기 위해 이를 간단히 할 수 있는 워드 매크로(vba)를 작성했습니다.
기능을 좀 더 추가하고 싶은게 있는데,
나중에 완성되면 다시 공유하겠습니다~
아래는 방법입니다.
일단 워드나 엑셀에 매크로를 한번도 사용해 본적이 없다면, 약간의 진입장벽이 있을 수 있습니다.
그래도 이번 기회에 한번 도전해 보는 것을 추천드립니다.
처음이 어렵고 한번 알면 무척 단순합니다.
매크로 실행은 다음을 참고하세요. (https://mainia.tistory.com/3881)
이해가 안되는 부분 있으면 글 남겨주세요.
1) 일단 워드를 열고
2) 원하는 지문을 가져옵니다. 이때 텍스트의 색상은 모두 자동으로 해주세요. (중요!)
3) 아래 그림을 참고해, 문장 어순배열이 필요한 곳에 밑줄을 추가합니다. (공백 없이 해당 부분만 선택합니다)
4) 이때 문장 전체를 선택해도 되지만, 가급적 의미 단위로 선택합니다.
5) 밑줄 친 중간의 쉼표나 콜론, 세미콜론 등은 배열할 때 제거하도록 설정되어 있습니다.
6) 밑줄은 1개여도 좋고, 여러개여도 됩니다. 필요한 만큼 밑줄을 만들고 내장된 매크로(ShuffleUnderlinedWords)를 실행합니다.
7) 이후 다시 필요한 부분에 밑줄을 만들고 매크로를 실행하면 됩니다.
아래는 결과물에 대한 예시입니다.
원본 + 밑줄
변환된 모습
아래 코드는 참고하시고, 필요한 경우 수정해서 사용하세요.
대부분의 내용을 chatGPT가 만들어 주었고,
일부 오류나는 부분은 제가 수정했고, 간단한 내용을 추가했습니다.
Option Explicit
Sub ShuffleUnderlinedWords()
' 변수 선언
Dim oDoc As Document
Dim oRange As Range
Dim ooRange As Range
Dim oooRange As Range
Dim sText As String
Dim modText As String
Dim vWords() As String
Dim sResult As String
Dim i As Long, j As Long
Dim tmp As String
' 현재 활성화된 문서를 선택
Set oDoc = ActiveDocument
' 문서의 모든 범위를 순회
For Each oRange In oDoc.StoryRanges
With oRange.Find
' 서식 초기화 및 검색 조건 설정
.ClearFormatting
.Font.underline = wdUnderlineSingle
.Font.Color = wdColorAutomatic
.Text = ""
.Wrap = wdFindContinue
' 밑줄 친 텍스트 찾기
.Execute
' 밑줄 친 텍스트를 찾으면 실행
While .Found
' 텍스트의 글자 색이 흰색이 아닌 경우 실행
If oRange.Font.Color <> wdColorWhite Then
' 텍스트 추출 및 단어 분할
sText = Trim(oRange.Text)
modText = sText
' 텍스트에서 쉼표나 콜론과 같은 특수문자를 제거함
modText = Replace(modText, """", "")
modText = Replace(modText, Chr(34), "")
modText = Replace(modText, ", ", "")
modText = Replace(modText, ":", "")
modText = Replace(modText, ";", "")
modText = Replace(modText, "—", "")
vWords = Split(modText, " ")
Randomize
' 단어 섞기
For i = LBound(vWords) To UBound(vWords)
j = CLng(((UBound(vWords) - i) * Rnd) + i)
tmp = vWords(i)
vWords(i) = vWords(j)
vWords(j) = tmp
Next i
' 결과 문자열 생성
sResult = "["
For i = LBound(vWords) To UBound(vWords)
sResult = sResult & vWords(i) & " / "
Next i
sResult = Left(sResult, Len(sResult) - 3) & "]"
' 밑줄 제거, 공백 추가, 결과 삽입
oRange.Font.underline = wdUnderlineNone
oRange.InsertAfter " " & sResult
' 기존 밑줄 친 텍스트 다시 찾아 색상은 흰색으로, 밑줄 생성하고 검정색으로 변경
Set ooRange = oRange.Duplicate
Call ChangeTextColorInRange(sText, ooRange)
' 수정된 텍스트의 크기 및 색상을 지정 (Darkred 및 8.5)
Set oooRange = oRange.Duplicate
Call ChangeModifiedTextColor(sResult, oooRange)
End If
' 다음 밑줄 친 텍스트 찾기
.Execute
Wend
End With
Next oRange
End Sub
Function ChangeTextColorInRange(searchText As String, targetRange As Range) As Boolean
Dim objRange As Range
Dim spacing As Single
Set objRange = targetRange
spacing = 4 '배율 설정 (문자간격 조정. 빈칸을 넓히려면 숫자를 더 크게 조정할 것)
With objRange.Find
.Text = searchText
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
objRange.Font.Color = wdColorWhite
objRange.Font.spacing = objRange.Font.spacing + spacing
objRange.Font.underline = wdUnderlineSingle
objRange.Font.UnderlineColor = wdColorBlack
objRange.Collapse wdCollapseEnd
ChangeTextColorInRange = True
Loop
End With
End Function
Function ChangeModifiedTextColor(searchText As String, targetRange As Range) As Boolean
Dim objRange As Range
Dim spacing As Single
Set objRange = targetRange
spacing = 0.2 '배율 설정 (문자간격 조정. 빈칸을 좁히려면 숫자를 더 작게 조정할 것)
With objRange.Find
.Text = searchText
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
objRange.Font.Size = 7 ' 랜덤 셔플링된 텍스트의 글자 크기 조정
objRange.Font.Color = 192 '색상 조정 (진한빨강)
objRange.Font.Bold = True 'Bold
objRange.Font.spacing = objRange.Font.spacing - spacing
objRange.Collapse wdCollapseEnd
ChangeModifiedTextColor = True
Loop
End With
End Function