Pages

[WD-2003] Problème avec ConverToShape d'inlineShape sujet

jeudi 30 janvier 2014




Bonjour a tous,

Voilà quelques temps que je cogite sur ce problème et je dois avouer que malgré mes recherches et mes essais je n'arrive pas à m'en sortir.

Mon programme est censé me créer un tableau de deux colonnes et ensuite le remplir avec diverses informations dont des images. Ce tableau rempli il y a alors un passage à une autre feuille et création d'un nouveau tableau et ainsi de suite jusqu'à ce que toutes les informations soient inscrites.

Le programme fonctionne jusqu'à ce que change de page, le tableau se créer bien, les informations commence à s'inscrire mais quand une image arrive je veux la convertir en Shape et là j'obtiens le message d'erreur suivant :


Citation:









Erreur d'execution '-2147467259 (80004005)':
La méthode 'ConvertToShape' de l'objet 'inlineShape' a échoué




(Notez bien que cela marche pour la première feuille)
Autre fait déroutant c'est que mon programme fonctionne très bien quand je fais une execution pas à pas

J'aimerais donc savoir :

Citation:









Comment se fait il que j'obtienne une erreur lors de ma conversion en Shape de mon InlineShape alors que cela fonctionne dans un premier temps ?




Voici mon code pour ce programme :


Code:


Sub MonTest()

    chem = "c:\lala.bmp"

    a = creationTableau
   
    Call Macro7(20, "NOIR", "NO3444", "998x67", 6, chem, 10, a)
    Call Macro8("NO2544", "100x500", 2, chem, a)
   
    Call nvlPage

    b = creationTableau(2)
 
    Call Macro7(20, "NOIR", "NO3444", "998x67", 6, chem, 10, b, 2)

End Sub



Code:


Sub Macro7(Ep, Mat, Ndessin, Dime, Qte, chem, pos, box, Optional page)
 
    ActiveDocument.Tables(box).Columns(1).Select
   
    If pos = 10 Or pos = 24 Or pos = 38 Then
        place = Selection.Paragraphs.Count
        Selection.Range = Selection.Paragraphs(place).Range
        Selection.InsertAfter Text:=Mat & " ;  ep. " & Ep & " mm ;" & Chr(13)
        Selection.Paragraphs(Selection.Paragraphs.Count).Range.Font.Bold = True
    Else
        place = Selection.Paragraphs.Count
        Selection.Paragraphs(place - 2).Range.Select
        Selection.InsertAfter Text:=Mat & " ;  ep. " & Ep & " mm ;" & Chr(13)
        Selection.Paragraphs(Selection.Paragraphs.Count).Range.Font.Bold = True
    End If
   
   
    Selection.InsertAfter Text:=Chr(13)
   
    place = Selection.Paragraphs.Count
    chem = Replace(chem, "GEO", "bmp")
    If pos = 10 Or pos = 24 Or pos = 38 Then
        With Me.InlineShapes.AddPicture(FileName:=chem, LinkToFile:=False, SaveWithDocument:=True, Range:=Selection.Paragraphs(place).Range)
        .Height = 50
        .Width = 50
        '.ConvertToShape
        End With
    Else
        With Me.InlineShapes.AddPicture(FileName:=chem, LinkToFile:=False, SaveWithDocument:=True, Range:=Selection.Paragraphs(place).Range)
        .Height = 50
        .Width = 50
        '.ConvertToShape
        End With
    End If

    ActiveDocument.Tables(box).Columns(1).Select
    Selection.InlineShapes(1).ConvertToShape
   
    Selection.InsertAfter Text:=Chr(13)
    Selection.InsertAfter Text:="                  Num: " & Ndessin & " ;  Qté : " & Qte & Chr(13)
    Selection.InsertAfter Text:="                  Dim: " & Dime & Chr(13)
    Selection.InsertAfter Text:=Chr(13)
       
End Sub



Code:


Sub Macro8(Ndessin, Dime, Qte, chem, box)
   
    ActiveDocument.Tables(box).Columns(1).Select

    place = Selection.Paragraphs.Count
    chem = Replace(chem, "GEO", "bmp")
    With Me.InlineShapes.AddPicture(FileName:=chem, LinkToFile:=False, SaveWithDocument:=True, Range:=Selection.Paragraphs(place - 2).Range)
        .Height = 50
        .Width = 50
        '.ConvertToShape
    End With
    ActiveDocument.Tables(1).Columns(1).Select
    Selection.InlineShapes(1).ConvertToShape
 
    Selection.InsertAfter Text:=Chr(13)
    Selection.InsertAfter Text:="                  Num: " & Ndessin & " ;  Qté : " & Qte & Chr(13)
    Selection.InsertAfter Text:="                  Dim: " & Dime & Chr(13)
    Selection.InsertAfter Text:=Chr(13)
       
End Sub



Code:


Sub nvlPage()
    ActiveDocument.Select
    Selection.EndKey Unit:=wdStory
    Selection.InsertBreak Type:=wdPageBreak
End Sub



Code:


Function creationTableau(Optional page)

    If IsMissing(page) = False Then
        ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=chr34 & page & chr34).Select
    End If
   
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
        If .Style <> "Grille du tableau" Then
            .Style = "Grille du tableau"
        End If
        .Cell(1, 1).Width = 280
        .Cell(1, 2).Width = 280
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
        .Rows(1).Height = 700
        .Rows.HorizontalPosition = -5
    End With
   
    creationTableau = ActiveDocument.Tables.Count
   
End Function


En vous remerciant d'avance pour votre aide et n'hésitez pas à demander des clarifications si besoin est.




Aucun commentaire:

Enregistrer un commentaire