Commit 0502e13e authored by Edith Cannet's avatar Edith Cannet
Browse files

correction macro affichage texte alt lors que des images du texte n'ont pas de... 

correction macro affichage texte alt lors que des images du texte n'ont pas de texte alt (ticket #117)
parent 5ae24e64

MS_Word/Metopes/vba/modules/figures.bas

+40 −72
Original line number Diff line number Diff line
@@ -9,12 +9,12 @@ Sub figure_credits(control As IRibbonControl) 
    paragraphs.style = ActiveDocument.Styles("TEI_figure_credits")

End Sub

Sub figure_alternative(control As IRibbonControl)

    paragraphs.style = ActiveDocument.Styles("TEI_figure_alternative")

    #If Mac Then

        Call insertFigMac

    #Else

        Call insertFigWin

    #End If

    paragraphs.style = ActiveDocument.Styles("TEI_figure_alternative")

End Sub

Sub formula(control As IRibbonControl)

    paragraphs.style = ActiveDocument.Styles("TEI_formula")
@@ -51,95 +51,53 @@ Sub figure_section(control As IRibbonControl) 
End Sub



Sub insertFig(control As IRibbonControl)

paragraphs.style = ActiveDocument.Styles(wdStyleNormal)

    #If Mac Then

        Call insertFigMac

    #Else

        Call insertFigWin

    #End If

    paragraphs.style = ActiveDocument.Styles(wdStyleNormal)

End Sub



Sub insertFigMac()

    Dim FolderPath As String

    Dim RootFolder As String

    Dim Scriptstr As String

    Dim IconoFolder As String

    Dim FilePath



    On Error Resume Next

    

    RootFolder = MacScript("return POSIX path of (path to documents folder) as String")

    RootFolder = MacScript("return POSIX file (""" & RootFolder & """) as string")

    FilePath = ActiveDocument.Path

    RootFolder = Left(ActiveDocument.Path, InStrRev(ActiveDocument.Path, "/"))

    IconoFolder = RootFolder & "icono/br"

    

    If Len(Dir(IconoFolder, vbDirectory)) = 0 Then

        RootFolder = MacScript("return POSIX file (""" & FilePath & """) as string")

            Scriptstr = "return POSIX path of (choose file with prompt ""File Selection""" & _

                " default location alias """ & RootFolder & """) as string"

   

        FolderPath = MacScript(Scriptstr)

        On Error GoTo 0

   

    If FolderPath <> "" Then

        Selection.MoveRight Unit:=wdCharacter, Count:=1

        Selection.MoveUp Unit:=wdParagraph, Count:=1

        Selection.InlineShapes.AddPicture FileName:= _

            FolderPath, LinkToFile:=True, SaveWithDocument:=False



    End If

End Sub



Sub insertFigWin()

Dim pickFile As FileDialog

Dim FolderPath As String



Set pickFile = Application.FileDialog(msoFileDialogFilePicker)



    With pickFile

        .Title = "Select Picture"

        .AllowMultiSelect = False

        If .Show <> -1 Then Exit Sub

        FolderPath = .SelectedItems(1)

    End With

 

 

    If FolderPath <> "" Then

        Selection.MoveRight Unit:=wdCharacter, Count:=1

        Selection.MoveUp Unit:=wdParagraph, Count:=1

        Selection.InlineShapes.AddPicture FileName:= _

            FolderPath, LinkToFile:=True, SaveWithDocument:=False

    End If



End Sub

Sub insertFigInline(control As IRibbonControl)

    #If Mac Then

        Call insertFigMacInline

    #Else

        Call insertFigWinInline

    #End If

End Sub



Sub insertFigMacInline()

    Dim FolderPath As String

    Dim RootFolder As String

    Dim Scriptstr As String



    On Error Resume Next



    RootFolder = MacScript("return POSIX path of (path to documents folder) as String")

    RootFolder = MacScript("return POSIX file (""" & RootFolder & """) as string")

    Else

        RootFolder = MacScript("return POSIX file (""" & IconoFolder & """) as string")

            Scriptstr = "return POSIX path of (choose file with prompt ""File Selection""" & _

                " default location alias """ & RootFolder & """) as string"

   

        FolderPath = MacScript(Scriptstr)

        On Error GoTo 0

    End If

    

    If FolderPath <> "" Then

   

        Selection.InlineShapes.AddPicture FileName:= _

        Selection.InlineShapes.AddPicture fileName:= _

            FolderPath, LinkToFile:=True, SaveWithDocument:=False

        Selection.Delete Unit:=wdCharacter, Count:=1



    End If

End Sub



Sub insertFigWinInline()

Sub insertFigWin()

Dim pickFile As FileDialog

Dim FolderPath As String

Dim IconoFolder As String



Set pickFile = Application.FileDialog(msoFileDialogFilePicker)
@@ -147,15 +105,22 @@ Set pickFile = Application.FileDialog(msoFileDialogFilePicker) 
        .Title = "Select Picture"

        .AllowMultiSelect = False

        If .Show <> -1 Then Exit Sub

        RootFolder = Left(ActiveDocument.Path, InStrRev(ActiveDocument.Path, "\"))

        IconoFolder = RootFolder & "\icono\br"

        

        If InStr(IconoFolder, "\\") > 0 Then

            FolderPath = ActiveDocument.Path

        Else

            FolderPath = IconoFolder

        End If

        If .SelectedItems.Count > 0 Then

            FolderPath = .SelectedItems(1)

        End If

    End With

 

 'MsgBox FolderPath

 

    If FolderPath <> "" Then

        Selection.InlineShapes.AddPicture FileName:= _

        Selection.InlineShapes.AddPicture fileName:= _

            FolderPath, LinkToFile:=True, SaveWithDocument:=False

        Selection.Delete Unit:=wdCharacter, Count:=1

    End If



End Sub
@@ -164,10 +129,12 @@ Sub InsertAltTextCaptions() 
Dim AltTextCaption As String

Dim ImageRange As Range

Dim AltTextParagraph As Paragraph

Dim i As Integer



Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst

With ActiveDocument

    For i = 1 To .InlineShapes.Count

      If Not .InlineShapes(i).AlternativeText = "" Then 'Vrifie si le text alternatif est vide

        AltTextCaption = .InlineShapes(i).AlternativeText

        Set ImageRange = .InlineShapes(i).Range

        ImageRange.Collapse Direction:=wdCollapseEnd
@@ -175,6 +142,7 @@ With ActiveDocument 
        ImageRange.InsertAfter AltTextCaption

        Set AltTextParagraph = ImageRange.paragraphs.Last

        AltTextParagraph.style = ActiveDocument.Styles("TEI_figure_alttext")

      End If

    Next

End With