Приключения вайбкодера в Ворде, или Как две нейронки не осилили простенькую задачку

Option Explicit
DefLng I-N, Q
DefSng X
DefStr S
DefDbl D
DefBool B

#If VBA7 Then
    ' 64-bit Windows API Declarations for Clipboard Management
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As String, ByVal Length As LongPtr)
#Else
    ' 32-bit Legacy Declarations (for backwards compatibility)
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As String, ByVal Length As Long)
#End If

Private Const GMEM_MOVEABLE As Long = &H2
Private Const CF_TEXT As Long = 1

' ==============================================================================
' MAIN AUTOMATION ENTRY POINT
' ==============================================================================
Public Sub wd_ConvertAllLatex2EqObjects()
  Dim Doc As Document
  Dim Sel As Selection
  Dim Prg As Word.Paragraph
  
  Dim sEq As String, sWd As String
  Dim sStart, sEnd
  Dim iPstart, iPend, iEqCountInline, iEqCountCentered, iPrg
  Dim bStarted, bEnded
  
  iPstart = 0
  Set Doc = ActiveDocument
  Set Sel = Selection
  bStarted = False
  bEnded = False
  sEnd = ""
  
  '======================
  ' Inline equations
  '======================
  sStart = "$"
  sEnd = "$"
  Sel.HomeKey wdStory
  iEqCountInline = 0
  Do
    Do
      ' Find starting delimiter
      SetSelectionFind sStart, bWildcards:=False
      If Not Sel.Find.Execute() Then
        Exit Do
      End If
      
      Set Prg = Sel.Paragraphs(1)
      iPstart = Sel.Start
      ' Find ending delimiter
      Sel.MoveRight wdCharacter
      SetSelectionFind sEnd, bWildcards:=False
      If Not Sel.Find.Execute() Then
        Exit Do
      End If
      If Sel.End > Prg.Range.End Then
        ' second delimiter out of paragraph
        Sel.EndKey wdLine
        Exit Do
      End If
      iPend = Sel.End
      
      ' Convert content inside delimiters
      Doc.Range(iPstart, iPend).Select
      ConvertSelectedLaTeXToOfficeEquation sStart, sEnd
      With Sel
        .MoveRight wdCharacter
      End With
      iEqCountInline = iEqCountInline + 1
    Loop
    If Sel.Paragraphs(1).Range.End >= Doc.Range.End - 1 Then
      Exit Do
    End If
    Sel.EndKey wdLine
    Sel.MoveDown wdParagraph
  Loop
  
  '======================
  ' Centered equations
  '======================
  sStart = "\["
  sEnd = "\]"
  Sel.HomeKey wdStory
  iEqCountCentered = 0
  Do
    ' Find starting delimiter
    SetSelectionFind sStart, bWildcards:=False
    If Not Sel.Find.Execute() Then
      Exit Do
    End If
    
    iPstart = Sel.Start
    
    ' Find ending delimiter
    Sel.MoveRight wdCharacter
    SetSelectionFind sEnd, bWildcards:=False
    If Not Sel.Find.Execute() Then
      Exit Do
    End If
    iPend = Sel.End
    
    ' Convert content inside delimiters
    Doc.Range(iPstart, iPend).Select
    ConvertSelectedLaTeXToOfficeEquation sStart, sEnd
    With Sel
      .MoveRight wdCharacter
      .Delete wdCharacter
      .HomeKey wdLine
      .MoveLeft wdCharacter
      .TypeText Text:=vbTab
      .ParagraphFormat.Alignment = wdAlignParagraphJustify 'wdAlignParagraphCenter
      .HomeKey wdLine
      .MoveLeft wdCharacter
      .Delete
      .MoveLeft wdCharacter
      .Delete
      .MoveDown wdParagraph
    End With
    iEqCountCentered = iEqCountCentered + 1
  Loop
  
  ' Finish
  MsgBox CStr(iEqCountCentered) & " right-numbered and " _
    & CStr(iEqCountInline) & " inline equation(s) converted"
  
pExit:
  Set Sel = Nothing
  Set Doc = Nothing
  Set Prg = Nothing
End Sub

' ==============================================================================
' PRIVATE HELPER ROUTINES & API INTERFACES
' ==============================================================================
Private Sub ConvertSelectedLaTeXToOfficeEquation _
  (Optional Start As String = "\[", Optional sEnd As String = "\]")

    Dim latexString As String
    Dim originalRange As Range
    Dim insertRange As Range

    If Selection.Range.Start = Selection.Range.End Then
        MsgBox "Please select a LaTeX expression.", vbExclamation
        Exit Sub
    End If

    Set originalRange = Selection.Range.Duplicate
    latexString = Trim$(originalRange.Text)

    ' Remove paragraph or table-cell terminators.
    If Right$(latexString, 2) = Chr$(13) & Chr$(7) Then
        latexString = Left$(latexString, Len(latexString) - 2)
    ElseIf Right$(latexString, 1) = Chr$(13) Then
        latexString = Left$(latexString, Len(latexString) - 1)
    End If

    ' Add display-math delimiters only when they are absent.
    If Left$(latexString, Len(Start)) <> Start Or Right$(latexString, Len(sEnd)) <> sEnd Then
        latexString = Start & latexString & sEnd
    End If

    CopyToClipboardAPI latexString
    
    Wait
    Selection.Paste
End Sub

Private Sub CopyToClipboardAPI(ByVal textToCopy As String)
    Dim hGlobalMemory As LongPtr
    Dim lpGlobalMemory As LongPtr
    
    ' Allocate moveable memory for the string
    hGlobalMemory = GlobalAlloc(GMEM_MOVEABLE, Len(textToCopy) + 1)
    If hGlobalMemory = 0 Then Exit Sub
    
    ' Lock the block and copy string into it
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    If lpGlobalMemory <> 0 Then
        MoveMemory lpGlobalMemory, textToCopy, Len(textToCopy) + 1
        GlobalUnlock hGlobalMemory
        
        ' Open clipboard and pass the data handle
        If OpenClipboard(0) <> 0 Then
            EmptyClipboard
            SetClipboardData CF_TEXT, hGlobalMemory
            CloseClipboard
        End If
    End If
End Sub

Private Sub Wait(Optional xTimeSec = 0.1)
  Dim pauseTime As Single
  pauseTime = Timer() + xTimeSec
  
  ' Midnight rollover protection checking if timer overflows past 24 hours
  If pauseTime >= 86400 Then pauseTime = pauseTime - 86400
  
  Do While Timer() < pauseTime
      DoEvents
  Loop
End Sub

Private Sub SetSelectionFind( _
  sFind As String, _
  Optional sReplace As String = "", _
  Optional bStop As Boolean = True, _
  Optional bForward As Boolean = True, _
  Optional bWholeWord As Boolean = False, _
  Optional bWildcards As Boolean = True _
)
  With Selection.Find
    .ClearFormatting
    .Text = sFind
    .Replacement.Text = sReplace
    .Forward = bForward
    If bStop Then
      .Wrap = wdFindStop
    Else
      .Wrap = wdFindContinue
    End If
    .Format = False
    .MatchByte = False
    .MatchWildcards = bWildcards
    .MatchAllWordForms = False
    .MatchWholeWord = bWholeWord
  End With
End Sub

Option Explicit

' ==============================================================================
' GLOBAL AUTOEXEC ADD-IN RIBBON INITIALIZATION
' ==============================================================================
Public Sub Autoexec()
    Dim contextMenu As CommandBar
    Dim customButton As CommandBarButton
    
    Set contextMenu = Application.CommandBars("Text")
    
    On Error Resume Next
    contextMenu.Controls("LaTeX -> Equations").Delete
    On Error GoTo 0
    
    Set customButton = contextMenu.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With customButton
        .Caption = "LaTeX -> Equations"
        .OnAction = "wd_ConvertAllLatex2EqObjects"
        .FaceId = 353 
    End With
End Sub