Need word macro to export and import alt text.

I think this set of macros will work for you. I'll be very interested to hear of any problems you have with it, especially if the translation involves languages that don't use a "roman" character set or that involve right-to-left text.

Unfortunately, the idea of a strictly sequence-based replacement won't work in Word, because the sequence of floating pictures depends on the locations of their anchors, not the locations of the pictures themselves. This becomes especially difficult if two or more pictures are anchored in the same paragraph.

Instead, the export macro creates a two-column table with each picture's alt text in the left column. Your translator must enter the corresponding translation in the right column of the same row. The import macro depends on using the full text of the original alt text as a search term to locate the correct row in the table, and it replaces the picture's alt text with the contents of the table cell to the right.

Sub ExportAltText()
    Dim strPictures As String
    Dim docPictures As Document
    Dim docTranslate As Document
    Dim objInlinePic As InlineShape
    Dim objFloatPic As Shape
    Dim tblTranslate1 As Table
    Dim tblTranslate2 As Table
    Dim tblLoop As Table
    Dim rowCurrent As Row
    Dim oRg As Range

    MsgBox "In the next dialog, select the file containing " & _
        "the pictures whose alt text will be translated."
    strPictures = GetFileName()
    If strPictures = "" Then Exit Sub

    On Error GoTo BadInputFile
    Set docPictures = Documents.Open(FileName:=strPictures)

    Set docTranslate = Documents.Add
    With docTranslate
        ' set up header and footer in translation document
        .Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = _
            "Alt Text of " & docPictures.FullName
        Set oRg = .Sections(1).Footers(wdHeaderFooterPrimary).Range
        oRg.Text = vbTab
        oRg.Collapse wdCollapseEnd
        .Fields.Add Range:=oRg, Type:=wdFieldPage, PreserveFormatting:=False

        ' create two 2x2 tables
        Set tblTranslate1 = .Tables.Add(Range:=.Range, numrows:=2, numcolumns:=2)


        Set oRg = .Range
        oRg.InsertParagraphAfter
        Set oRg = .Range
        oRg.Collapse wdCollapseEnd

        Set tblTranslate2 = .Tables.Add(Range:=oRg, numrows:=2, numcolumns:=2)

        ' put the docPictures path & filename in a document variable
        ' so the import macro can locate it
        .Variables("docPictures").Value = docPictures.FullName
    End With

    ' put a heading row in the table and set borders
    For Each tblLoop In docTranslate.Tables
        With tblLoop
            .Cell(1, 1).Range.Text = "Original Alt Text"
            .Cell(1, 2).Range.Text = "Translated Alt Text"
            .Rows(1).Range.Font.Bold = True
            .Rows(1).HeadingFormat = True
            .Borders.InsideColor = wdColorAutomatic
            .Borders.InsideLineStyle = wdLineStyleSingle
            .Borders.OutsideColor = wdColorAutomatic
            .Borders.OutsideLineStyle = wdLineStyleSingle
        End With
    Next tblLoop

    ' put the alt text of each inline picture into the first column of the table's
    ' last row, and add a new empty row below it
    On Error Resume Next
    For Each objInlinePic In docPictures.InlineShapes
        If objInlinePic.AlternativeText <> "" Then
            tblTranslate1.Rows.Last.Cells(1).Range.Text = objInlinePic.AlternativeText
            If Err.Number <> 0 Then
                MsgBox "Error " & Err.Number & vbCr & Err.Description
                Err.Clear
            End If
            tblTranslate1.Rows.Add
        End If
    Next objInlinePic
    tblTranslate1.Rows.Last.Delete

    ' put the alt text of each floating picture into the first column of the table's
    ' last row, and add a new empty row below it
    On Error Resume Next
    For Each objFloatPic In docPictures.Shapes
        If objFloatPic.AlternativeText <> "" Then
            tblTranslate2.Rows.Last.Cells(1).Range.Text = objFloatPic.AlternativeText
            If Err.Number <> 0 Then
                MsgBox "Error " & Err.Number & vbCr & Err.Description
                Err.Clear
            End If
            tblTranslate2.Rows.Add
        End If
    Next objFloatPic
    tblTranslate2.Rows.Last.Delete

    docPictures.Close wdDoNotSaveChanges
    docTranslate.Save

    Exit Sub

BadInputFile:
    MsgBox "The file " & strPictures & " could not be opened." & _
        vbCr & "Error " & Err.Number & vbCr & Err.Description
End Sub

Sub ImportAltText()
    Dim strPictures As String
    Dim strTranslate As String
    Dim docPictures As Document
    Dim docTranslate As Document
    Dim objInlinePic As InlineShape
    Dim objFloatPic As Shape
    Dim tblTranslate1 As Table
    Dim tblTranslate2 As Table
    Dim tblLoop As Table
    Dim rowCurrent As Row
    Dim oRg As Range

    MsgBox "In the next dialog, select the file containing " & _
        "the translated alt text."
    strTranslate = GetFileName()
    If strTranslate = "" Then Exit Sub

    On Error GoTo BadTranslateFile
    Set docTranslate = Documents.Open(FileName:=strTranslate)

    On Error GoTo BadPicVariable
    strPictures = docTranslate.Variables("docPictures").Value
GotFile:

    On Error GoTo BadPictureFile
    Set docPictures = Documents.Open(FileName:=strPictures)

    If docTranslate.Tables.Count < 2 Then
        MsgBox "The document " & strTranslate & " does not contain " & _
            "the required two or more tables (one for inline pictures and " & _
            "one for floating pictures)."
        Exit Sub
    End If

    On Error GoTo ErrHdl
    Set tblTranslate1 = docTranslate.Tables(1)
    Set tblTranslate2 = docTranslate.Tables(2)

    ' Use each picture's existing alt text as the search term
    ' to find the same text in the first column of the
    ' tblTranslate1 table. If it's found, then use the text
    ' in the second column of the same row to replace the
    ' picture's alt text.
    For Each objInlinePic In docPictures.InlineShapes
        If objInlinePic.AlternativeText <> "" Then
            Set oRg = tblTranslate1.Range
            With oRg.Find
                .Text = objInlinePic.AlternativeText
                .Wrap = wdFindStop
                .Forward = True
                If .Execute Then
                    If oRg.InRange(tblTranslate1.Range) Then
                        objInlinePic.AlternativeText = _
                        GetCellContent(tblTranslate1.Cell( _
                            oRg.Information(wdEndOfRangeRowNumber), 2))
                    End If
                End If
            End With
        End If
    Next objInlinePic

    ' Do the same for floating pictures
    For Each objFloatPic In docPictures.Shapes
        If objFloatPic.AlternativeText <> "" Then
            Set oRg = tblTranslate2.Range
            With oRg.Find
                .Text = objFloatPic.AlternativeText
                .Wrap = wdFindStop
                .Forward = True
                If .Execute Then
                    If oRg.InRange(tblTranslate2.Range) Then
                        objFloatPic.AlternativeText = _
                        GetCellContent(tblTranslate2.Cell( _
                            oRg.Information(wdEndOfRangeRowNumber), 2))
                    End If
                End If
            End With
        End If
    Next objFloatPic

    Exit Sub

BadTranslateFile:
    MsgBox "The file " & strTranslate & " could not be opened." & _
        vbCr & "Error " & Err.Number & vbCr & Err.Description
    Exit Sub

BadPicVariable:
    MsgBox "This document doesn't have the expected information " & _
        "about the picture file's location. In the next dialog, " & _
        "select the picture file."
    strPictures = GetFileName()
    If strPictures = "" Then Exit Sub
    Resume GotFile

BadPictureFile:
    MsgBox "The file " & strPictures & " could not be opened." & _
        vbCr & "Error " & Err.Number & vbCr & Err.Description
    Exit Sub

ErrHdl:
    ' generic error handler
    MsgBox "Error " & Err.Number & vbCr & Err.Description
End Sub

Function GetFileName() As String
    Dim dlg As FileDialog

    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    If dlg.Show <> -1 Then
        GetFileName = ""
    Else
        GetFileName = dlg.SelectedItems(1)
    End If
End Function

Function GetCellContent(objCell As Cell) As String
    Dim rg As Range

    Set rg = objCell.Range
    rg.MoveEnd wdCharacter, -1  ' exclude cell marker
    GetCellContent = rg.Text
End Function