VBA Excel-Word

Bonjour,

J'ai créé une macro qui permet de coller une plage de cellules copiées dans excel, dans un fichier word.

Je commence par copier ma plage de cellules (Ctrl+C) puis je lance ma macro dans word. Cette macro a deux fonctions :

1°Coller un tableau excel sous forme d'image, avec liaison dans un document word quelconque.

2°Redimensionner le tableau ainsi créé dans word.

Cette macro a très bien fonctionné pendant 3ans.

Mais je me retrouve aujourd'hui avec deux soucis :

1° Après le lancement de la macro, excel "clignote"

2° Ma macro de redimensionnement transforme le tableau-image (Objet InlineShape) en Objet Shape, de façon à savoir si l'image a été tournée à 90°. Word plante (redémarrage de word nécessaire...) à ce moment-là.

Voici ci-dessous le code (Coller en image):

Option Explicit

Sub Coller_image()
Dim fin As Long, NoPhoto As Long
Dim AvecLiaison As Boolean

fin = Selection.End
Selection.SetRange Start:=ActiveDocument.Content.Start, End:=fin
NoPhoto = Selection.InlineShapes.Count
NoPhoto = NoPhoto + 1
Selection.SetRange Start:=fin, End:=fin

Select Case MsgBox("Coller avec liaison ?", vbYesNo)
Case 6
    AvecLiaison = True
Case 7
    AvecLiaison = False
Case Else
    MsgBox ("Marche Pô")
    Exit Sub
End Select
On Error GoTo Suiv
Selection.PasteSpecial Link:=AvecLiaison, Placement:=wdInLine, DisplayAsIcon:=False, DataType:=wdPasteOLEObject
On Error GoTo 0
DoEvents
Application.ActiveDocument.InlineShapes(NoPhoto).Select
Call Ajuster.Ajuster(Application.ActiveDocument.InlineShapes(NoPhoto))
Exit Sub
Suiv:
MsgBox ("Copiez le tableau à insérer puis relancez la macro")
End Sub

Voici le code de la macro Ajuster, qui s'occupe du redimensionnement

Option Explicit

Sub Ajuster(Optional s As InlineShape = Nothing)
Dim Largeur_image As Double, PicHeight As Double, PicWidth As Double, RapportHL As Double
Dim Tol As Double
Dim Hauteur_Image As Double
Tol = CentimetersToPoints(0.05)
If Selection.InlineShapes.Count <> 1 And s Is Nothing Then
    MsgBox "Il faut sélectionner l'image à redimmensionner, et uniquement celle-ci !" & vbCrLf & "Fin Macro."
    End
End If
If s Is Nothing Then Set s = Selection.InlineShapes.Item(1)
With s.Range
    With .Sections(1).PageSetup
        Largeur_image = .TextColumns(1).Width - Tol
        Hauteur_Image = .PageHeight - .TopMargin - .BottomMargin - CentimetersToPoints(2)
        If Not .TextColumns.EvenlySpaced Then MsgBox ("Vos colonnes ont des largeurs variables, " & _
                "il est possible que le résultat de la macro ne soit pas celui escompté.")
    End With
    Largeur_image = Largeur_image - .ParagraphFormat.LeftIndent - .ParagraphFormat.RightIndent
End With
Call Rotation(s, Hauteur_Image, Largeur_image)
With s
    .ScaleHeight = 100
    .ScaleWidth = 100
    .LockAspectRatio = msoFalse
    PicHeight = .Height
    PicWidth = .Width
    If PicWidth > Largeur_image Then
        RapportHL = PicHeight / PicWidth
        .Width = Largeur_image
        .Height = .Width * RapportHL
    End If
    PicHeight = .Height
    If PicHeight > Hauteur_Image Then
        .Height = Hauteur_Image
        .Width = .Height / RapportHL
    End If
    .LockAspectRatio = msoTrue
End With

End Sub

Sub Rotation(ByRef Ishp As InlineShape, ByRef H As Double, ByRef L As Double)
Dim Temp As Double
Dim Shp As Shape

Set Shp = Ishp.ConvertToShape
DoEvents
If Shp.Rotation <> 0 Then
    If Shp.Rotation Mod 90 = 0 Then
        Temp = H
        H = L
        L = Temp
    End If
End If
Set Ishp = Shp.ConvertToInlineShape
DoEvents
End Sub

Word plante dans la sub "Rotation", sur la première ligne de commande (Set Shp = ishp.converttoshape)

La macro tourne dans word, et est appelée depuis un fichier *.dotm placé dans le dossier "STARTUP" de word.

Je suis passé de Win7 à Win 8.1, mais resté en Word2010.

Si quelqu'un avait quelques pistes de solution, ça m'aiderai grandement !

Merci d'avance,

Cdlt,

Florian