질문)엑셀 텍스트 타이핑효과넣기

Option Explicit

'=== Windows Sleep API (0.2초 간격을 위해) ===
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

'=== 사용자 설정: 타이핑할 문장 & 출력 위치 & 간격(ms) ===
Private Const TARGET_TEXT As String = "오빠두엑셀 사랑합니다"
Private Const TARGET_ADDRESS As String = "A1"
Private Const STEP_INTERVAL_MS As Long = 100   ' 0.2초

'=== 초성(0~18) → 호환 자모 코드포인트(U+3131~) ===
Private ChoCompat() As Long ' ㄱ,ㄲ,ㄴ,ㄷ,ㄸ,ㄹ,ㅁ,ㅂ,ㅃ,ㅅ,ㅆ,ㅇ,ㅈ,ㅉ,ㅊ,ㅋ,ㅌ,ㅍ,ㅎ

Private Sub InitChoArrays()
    ' U+3131 ㄱ, 3132 ㄲ, 3134 ㄴ, 3137 ㄷ, 3138 ㄸ, 3139 ㄹ, 3141 ㅁ, 3142 ㅂ, 3143 ㅃ,
    ' 3145 ㅅ, 3146 ㅆ, 3147 ㅇ, 3148 ㅈ, 3149 ㅉ, 314A ㅊ, 314B ㅋ, 314C ㅌ, 314D ㅍ, 314E ㅎ
    Dim a As Variant
    a = Array(&H3131, &H3132, &H3134, &H3137, &H3138, &H3139, _
              &H3141, &H3142, &H3143, &H3145, &H3146, &H3147, _
              &H3148, &H3149, &H314A, &H314B, &H314C, &H314D, &H314E)
    ReDim ChoCompat(0 To 18)
    Dim i As Long
    For i = 0 To 18
        ChoCompat(i) = CLng(a(i))
    Next i
End Sub

'=== 메인 시작 루틴 ===
Public Sub StartHangulTyping()
    On Error GoTo ErrHandler
    
    If Not Initialized Then InitChoArrays
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ws.Range(TARGET_ADDRESS).ClearContents
    
    Dim i As Long, ch As String, code As Long
    Dim acc As String
    acc = ""
    
    For i = 1 To Len(TARGET_TEXT)
        ch = Mid$(TARGET_TEXT, i, 1)
        code = AscW(ch)
        
        If IsHangulSyllable(code) Then
            Dim L As Long, V As Long, T As Long
            DecomposeHangul code, L, V, T
            
            ' 1) 초성(호환 자모)만 보여주기
            acc = acc & ChrW$(ChoCompat(L))
            ws.Range(TARGET_ADDRESS).Value = acc
            Sleep STEP_INTERVAL_MS
            
            ' 2) 초성+중성으로 조합된 음절 출력
            acc = Left$(acc, Len(acc) - 1) ' 초성 표시를 지우고
            acc = acc & ChrW$(ComposeHangul(L, V, 0))
            ws.Range(TARGET_ADDRESS).Value = acc
            Sleep STEP_INTERVAL_MS
            
            ' 3) 종성이 있으면 최종 음절로 갱신
            If T > 0 Then
                acc = Left$(acc, Len(acc) - 1)
                acc = acc & ChrW$(ComposeHangul(L, V, T))
                ws.Range(TARGET_ADDRESS).Value = acc
                Sleep STEP_INTERVAL_MS
            End If
            
        Else
            ' 한글 음절이 아니면 그대로 1스텝에 추가
            acc = acc & ch
            ws.Range(TARGET_ADDRESS).Value = acc
            Sleep STEP_INTERVAL_MS
        End If
    Next i
    
    Exit Sub
ErrHandler:
    MsgBox "실행 중 오류가 발생했습니다: " & Err.Description, vbExclamation, "Hangul Typing"
End Sub

Private Function Initialized() As Boolean
    Initialized = (Not (Not ChoCompat)) ' 배열 초기화 여부 확인 트릭
End Function

'=== 유니코드 한글 범위 확인 (가~힣: U+AC00~U+D7A3) ===
Private Function IsHangulSyllable(ByVal code As Long) As Boolean
    IsHangulSyllable = (code >= &HAC00 And code <= &HD7A3)
End Function

'=== 한글 분해: 코드포인트 → (초성L, 중성V, 종성T) ===
Private Sub DecomposeHangul(ByVal code As Long, ByRef L As Long, ByRef V As Long, ByRef T As Long)
    Dim S As Long
    S = code - &HAC00
    L = S \ 588                   ' 21*28 = 588
    V = (S Mod 588) \ 28
    T = S Mod 28                  ' 0이면 종성 없음
End Sub

'=== 한글 조합: (L, V, T) → 코드포인트 ===
Private Function ComposeHangul(ByVal L As Long, ByVal V As Long, ByVal T As Long) As Long
    ComposeHangul = &HAC00 + ((L * 21 + V) * 28) + T
End Function