Discussion :

[sergiocorleon]

BOnjour à tous,

Je sollicite votre aide parce que je suis bien bloqué, après avoir cherché nuit et jour je n'ai rien trouvé. MERCI D'AVANCE POUR VOS CONTRIBUTIONS.

Donc explication du problème:

J'ai une séquence qui crée dans une feuille word un tableau à 2 colonnes.
Dans la 2ème colonne, je souhaite en automatique créer une zone de dessin (CANVAS) dans laquelle on sélectionnerait une photo par le biais d'une interface type explorer, et qui insérait la photo dans la zone de dessin.

Voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub Tableau_2()
Dim MonDial As FileDialog
 
Dim shpCanvas As Shape
Dim sect As Table
 
'----------------------------------------------------------------------------------------------------------------
'Création du tableau a 2 colonnes "MARCHE BIEN" PROBLEME ETAPE SUIVANTE
'----------------------------------------------------------------------------------------------------------------
 
    'Laisse un espace avant et un espace après
    Selection.Style = ActiveDocument.Styles("Normal")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
 
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    Selection.Tables(1).Rows.HeightRule = wdRowHeightExactly
    Selection.Tables(1).Rows.Height = CentimetersToPoints(3)
    Selection.Tables(1).Rows.AllowBreakAcrossPages = False
    With Selection.Tables(1)
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColor = wdColorAutomatic
    End With
    Selection.Tables(1).Select
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    Selection.Font.Name = "Arial"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCell
 
'---------------------------------------------------------------------------------------------------------------
'insertion du canvas dans la case "NE MARCHE PAS"  A L'AIDE????
'---------------------------------------------------------------------------------------------------------------
Set shpCanvas = Activeselection.InlineShapes.AddCanvas(Left:=100, Top:=75, Width:=200, Height:=300)
 
'---------------------------------------------------------------------------------------------------------------
' Module de recherche de photo "FONCTIONNE BIEN"
'---------------------------------------------------------------------------------------------------------------
              Set MonDial = Application.FileDialog( _
              FileDialogType:=msoFileDialogOpen)
              With MonDial
' ICI tu peux , à l'aide des propriétés   "filters" et  "InitialFileName" affiner le travail
                    .AllowMultiSelect = True
                    .InitialFileName = ActiveDocument.Path
                    '.FileName = "*.jpg"
                    .Show
                 End With
'-----------------------------------------------------------------------------------------------------------------
' SEQUENCE DE COPIE DE PHOTO
'-----------------------------------------------------------------------------------------------------------------

"DONC ICI JE CHERCHE A COPIER LA PHOTO DANS LE CANVAS"
JE NE SAIS PAS QUOI METTRE

[Heureux-oli]

Salut,

Pourquoi ne pas utiliser un objet InlineShape au lieu d'un canevas ?


Voilà un exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Dim inSh As InlineShape
 
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Set inSh = Selection.InlineShapes.AddPicture(FileName:= _
    "C:\temp\a.jpg", _
         LinkToFile:=False, SaveWithDocument:=True)
 
With inSh
    .Height = 100
    .Width = 100
End With

Bien entendu, le chemin du fichier peut être récupéré par le biais de ta boîte de dialogue.

[sergiocorleon]

Bonsoir, merci pour votre réponse.

Je suis obligé de faire une zone de dessin pour y placer une photo et comme l'utilisateur ajoute des flèches et lettres, je peux comme ça à la fin grouper flèches,repères et la photo.

Ce document servira pour la rédaction de notices, donc cette macro permettrait que tous les utilisateurs fassent bien une zone de dessin avant de copier leur photo.

Avez-vous une idée de comment traduire en VB, la création d'une zone de dessin dans une des cases du tableau?

Merci pour votre aide.

[Heureux-oli]

Salut,

Le problème, c'est que la zone de dessin disparaît en 2007 et on ne parvient pas a gérer le contenu d'une zone de dessin via le VBA.

[sergiocorleon]

Pourtant l'option reste disponible dans l'onglet INSERTION / FORMES / ZONE DE DESSIN.

La transcription en VBA n'est pas réalisable?

Merci

[Heureux-oli]

Tu as raison pour 2007.
Je vais continuer à chercher.
On peut ajouter une zone de dessin, y ajouter un objet MS, mais j'ai toujours une erreur avec une image, que je sois en 2007 ou en 2003.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub AddInlineCanvas()
    Dim docNew As Document
    Dim shpCanvas As Shape
 
    Set docNew = Documents.Add
 
    'Add a drawing canvas to the new document
    Set shpCanvas = docNew.Shapes.AddCanvas( _
        Left:=150, Top:=150, Width:=70, Height:=70)
    shpCanvas.WrapFormat.Type = wdWrapInline
 
    'Add shapes to drawing canvas
    With shpCanvas.CanvasItems
        .AddShape msoShapeHeart, Left:=10, _
            Top:=10, Width:=50, Height:=60
        .AddLine BeginX:=0, BeginY:=0, _
            EndX:=70, EndY:=70
    End With
    With shpCanvas
        .CanvasItems(1).Fill.ForeColor _
            .RGB = RGB(Red:=255, Green:=0, Blue:=0)
        .CanvasItems(2).Line _
            .EndArrowheadStyle = msoArrowheadTriangle
    End With
End Sub

Ce code fonctionne sans problème, mais si je veux mettre une image, ça ne passe pas !

[sergiocorleon]

Bonsoir,

C'est un bon début, je vous remercie, avez-vous progressé sur le sujet?

cordialement

[Heureux-oli]

Même si je prends l'exemple donné dans l'aide sans rien changer, ça ne fonctionne pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub NewCanvasPicture()
    Dim shpCanvas As Shape
 
    'Add a drawing canvas to the active document
    Set shpCanvas = ActiveDocument.Shapes _
        .AddCanvas(Left:=100, Top:=75, _
        Width:=200, Height:=300)
 
    'Add a graphic to the drawing canvas
    shpCanvas.CanvasItems.AddPicture _
        FileName:="C:\Program Files\Microsoft Office\" & _
            "Office\Bitmaps\Styles\stone.bmp", _
        LinkToFile:=False, SaveWithDocument:=True
End Sub

Plus, je ne sais pas donner.

[Heureux-oli]

Salut,

J'ai fait appel à beaucoup plus fort que moi et Geo m'a donné la solution.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub NewCanvasPicture()
    Dim shpCanvas As Shape
 
    'Add a drawing canvas to the active document
    Set shpCanvas = ActiveDocument.Shapes _
        .AddCanvas(Left:=100, Top:=75, _
        Width:=200, Height:=300)
 
    'Add a graphic to the drawing canvas
    shpCanvas.CanvasItems.AddPicture _
        FileName:="C:\temp\a.jpg", _
        LinkToFile:=False, SaveWithDocument:=True, Left:=10, Top:=10, Width:=10, Height:=10
End Sub

Il faut donner une position et des dimensions à l'image.