[Résolu][Calc]Insérer une image à un endroit précis

[Drake]

Bonjour,

J'ai besoin d'insérer une image dans une feuille.
Je me suis servi du code généré par l'outil "enregistrer une macro" mais ce code est tributaire d'une cellule.
Ce que je voudrai c'est pouvoir insérer une image n'importe où sur la feuille (par ex avec des coordonnées x,y). Est-ce possible ?
Merci de votre aide.

[martinbrait]

Bonjour Drake,

à tester...

Code : Tout sélectionner

' #FUNCTION# ====================================================================================================================
' Name...........: InsereImageEtAjusteALaCellule_()
' Description ...: 
 ' le code suivant permet d'insérer des images de taille variable dans des cellules de taille variable
'- en ajustant chaque image à la cellule
'- en ancrant chaque image à la cellule
' Syntax.........: InsereImageEtAjusteALaCellule_(oDoc As Object, Feuille As Integer, Li As Long, Co As Long, Chemin As String)
' Parameters ....: $avArray - Array to modify
'                  $vValue  - Value to add
' Return values .: Success - Retourne le type simple, de contenu de la cellule.
'                  Failure - -1, sets @error
'                  |1 - $avArray is not an array
'                  |2 - $avArray is not a 1 dimensional array
' Author ........: Jean-Luc DELMAS
' Modified.......: martinbrait - code cleanup
' Remarks .......:
'Pour vérifier l'effet de l'ajustement et de l'ancrage à la cellule, on peut :
'- Modifier la largeur de la colonne ou la hauteur de certaines lignes avant de lancer la macro
'- Insérer une colonne ou une ligne, ou modifier la hauteur de certaines lignes après avoir lancé la macro
' Related .......: InsereImageTest,EffaceImages(oDoc As Object, Feuille As Integer),InsereImageEtAjusteALaCellule_(oDoc As Object, Feuille As Integer, Li As Long, Co As Long, Chemin As String),
' InsereImageEtAjusteALaCellule_(oDoc As Object, Feuille As Integer, Li As Long, Co As Long, Chemin As String)
' Link ..........;
' Example .......' Yes
' ===============================================================================================================================
    Sub InsereImageTest
       Dim oDoc As Object
       Dim Feuille As Integer
       Dim Li As Long, Co As Long
       Dim Chemin As String
       
'paramètres de ta feuille calc
       oDoc = ThisComponent
       Co = 1
       Feuille = 1

       EffaceImages(oDoc, Feuille)
       MsgBox "Images effacées"
       For Li = 5 To 20
          Chemin = "C:\Users\Public\Pictures\Sample Pictures\Tulipes.jpg"
          InsereImageEtAjusteALaCellule_(oDoc, Feuille, Li, Co, Chemin)
       Next Li
       MsgBox "Fin de l'insertion des images"
    End Sub

    Sub   EffaceImages(oDoc As Object, Feuille As Integer)
       Dim oFeuille, oPage, oImage As Object
       Dim NbImages, i As Integer
       oFeuille = oDoc.Sheets.getByIndex(Feuille - 1)
       oPage = oFeuille.getDrawPage()
       NbImages = oPage.getCount
       For i = NbImages To 1 Step -1
       oImage = oPage.getByIndex(i-1)
       oPage.remove(oImage)
       Next i
    End Sub

    Sub InsereImageEtAjusteALaCellule_(oDoc As Object, Feuille As Integer, Li As Long, Co As Long, Chemin As String)
       Dim sURL As String
       Dim oPage, oFeuille, oGraph, c As Object

       oFeuille = oDoc.Sheets.getByIndex(Feuille - 1)
       sUrl= ConvertToUrl (Chemin)

       oPage = oFeuille.getDrawPage()
       oGraph = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
       oGraph.GraphicURL = sURL
       
       oPage.add(oGraph)
       c = oFeuille.getCellByPosition(Co -1, Li - 1)
       oGraph.Anchor = c

       Dim oSize As New com.sun.star.awt.Size
       Dim LargeurCellule, HauteurCellule As Long
       Dim k1, k2, k As Double
          
       LargeurCellule = c.Size.Width
       HauteurCellule = c.Size.Height

       oSize = oGraph.Graphic.getSize
       With oSize
          k1 = LargeurCellule/.Width   
          k2 = HauteurCellule/.Height 
          If k1 < k2 Then
             k = k1
          Else
             k = k2
          End If
             .Width = .Width *k
             .Height = .Height*k   ' Hauteur
       End With
       oGraph.setsize(oSize)
    End sub

Merci et à bientôt !

[CBresso]

Bonjour,
Il y a aussi :

Code : Tout sélectionner

Option Explicit 
  
Sub CreationPlancheContact  
'testé avec WinXP et OOo 2.0.3  
'http://www.oooforum.org/forum/viewtopic.php?t=12312  
Dim sGraphicURL As String , Chemin As String , NextFile as String  
Dim oDrawPage As Object , oGraphic As Object  
Dim oFolderDialog as Object, oUcb as Object  
Dim choix As Integer ,i As Integer ,j As Integer ,k As Integer  
Dim oLeft As Double , oTop as Double ,NumLig as Double , Largeur As Double  
Dim Taille as new com.sun.star.awt.Size  
Dim Emplacement as new com.sun.star.awt.Point  
  
NumLig= ThisComponent.Sheets(0).RowPageBreaks(0).position  
Largeur= ThisComponent.Sheets(0).Rows(0).Height  
  
'--- Affiche la boîte de dialogue pour sélectionner le répertoire contenant les fichiers .jpg ---  
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")  
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")  
oFolderDialog.SetDisplayDirectory("C:\Documents and Settings")'Adaptez le chemin par défaut

choix = oFolderDialog.Execute()  
If choix = 1 Then Chemin=ConvertFromUrl(oFolderDialog.getDirectory())  
  
'Boucle sur toutes les images du répertoire cible 
'Attention la procédure est sensible à la casse 
'(jpg n'est pas identique à JPG)  
NextFile=Dir(Chemin & "\*.jpg",0)  
  
Do While Len(NextFile) >0  
  i = i + 1  
  j = j + 1  
  sGraphicURL =ConvertToURL(Chemin & "\" & NextFile)  
  
  oDrawPage =ThisComponent.Sheets(0).getDrawpage()  
  oGraphic =ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape")  
  oGraphic.GraphicURL =sGraphicURL  
  oDrawPage.add(oGraphic)  
  
  Taille.width = 3000 'Dimension horizontale image (3000 = 30 millimètres) 
  Taille.height = 3000 'Dimension verticale image  
  oGraphic.setsize(Taille)  
  
  Emplacement.X = oLeft  
  Emplacement.Y = oTop  
  oGraphic.setposition(Emplacement)  
  
  oLeft = oLeft + Taille.width + 350 'Distance horizontale entre 2 images  
  If i =4 then  
    oLeft =0  
    i =0  
    oTop = oTop + Taille.height + 500 ' Distance verticale entre 2 images  
  End If  
  
  if j = 20 Then '4 colonnes et 5 lignes par page d'impression 
    k =k + 1  
    oTop = NumLig * Largeur * k  
    j = 0  
  End If  
  
  NextFile=Dir()  
Loop  
End Sub

Trouvé sur h**p://openoffice-libreoffice.developpez.com/faq/?page=Les-images

Non, le code vient du défunt site oooforum.org

Cordialement,

[Drake]

Bonjour à vous,

Merci pour votre aide.

J'ai oublié de préciser que les cellules ne sont pas modifiables sur la feuille ni en hauteur ni en largeur.
En fait j'aimerai pouvoir positionner l'image n'importe où sur la feuille.
Comme on le ferait avec insertion d'une forme. Une fois la forme sur la feuille on peut la déplacer où l'on veut (à un endroit vierge !).

J'ai juste survolé le code posté par martinbrait Je ne pense pas que cela convienne car l'image s’insère dans une cellule.
Or dans ma feuille la plupart des cellules font la largeur de la feuille (feuille standard A4) et la position de l'image
Quand à ton code CBresso je ne pense pas avoir les compétences pour le déchiffrer complètement.
Néanmoins pourrais-tu me dire s'il conviendrait à ma demande compte tenu des précisions décrites plus haut ?

Merci, à bientôt

[Piaf]

Bonjour
Pourquoi ne pas utiliser la fonction de recherche du Forum ?
Calc insérer image
Tu devrais y trouver la réponse à ta question.
A+

[CBresso]

À priori oui mais pas testée
La macro proposée itère un répertoire d'images et les insère. Pour une image seule, tu définis comme tu veux l'objet oGraphic :

Code : Tout sélectionner

sGraphicURL =ConvertToURL(fichierImage) 'l'adresse de ton fichier image
 
  oDrawPage =ThisComponent.Sheets(0).getDrawpage() 
  oGraphic =ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape") ' Création d'un objet "image"
  oGraphic.GraphicURL =sGraphicURL 
  oDrawPage.add(oGraphic) 

et avec

Code : Tout sélectionner

  Taille.width = 3000 'Dimension horizontale image (3000 = 30 millimètres)
  Taille.height = 3000 'Dimension verticale image 
  oGraphic.setsize(Taille) 
 
  Emplacement.X = oLeft 
  Emplacement.Y = oTop 
  oGraphic.setposition(Emplacement)

Tu fais ce que du veux de l'image.

[Drake]

Bonsoir,

Salut Piaf j'avais effectué une recherche (sur le site et sur google) avant de poster mais je ne trouvai pas ce que je cherchai.
Surement lié à la difficulté à déchiffrer le code. (ça fait très longtemps que je ne code plus).

Heureusement notre ami CBresso (que je remercie pour le code et les explications qui m'ont bien aidé) a fournit un code qui répond à mon besoin.

Il a fallu tout de même mettre les mains dans le cambouis mais le résultat est satisfaisant.
A part cette bizarrerie, lorsque j'ouvre ma feuille en mode saisie.
En effet, après avoir cliqué sur le bouton déclenchant ma macro (qui insère une image sur la feuille), il arrive parfois que la ligne de menu s'affiche sur fond noir ainsi que l'image insérée.
Pas bien méchant, il suffit de faire un aller-retour sur le mode "Aperçu" pour que l'affichage redevienne normal.

Une petite question tout de même, l'image insérée est repositionnable (ce qui est parfait) mais il faut cliquer de nombreuses fois tout autour pour faire apparaitre le cadre qui permet de déplacer l'image.
Est-ce un comportement normal ?
Voici le code une fois modifié si ça peut aider quelqu'un d'autre.

Code : Tout sélectionner

Option Explicit

Sub InsertionImage 
    'testé avec WinXP et OOo 2.0.3 
    'http://www.oooforum.org/forum/viewtopic.php?t=12312 
Dim sGraphicURL As String  'Chemin As String , NextFile as String 
Dim oDrawPage As Object , oGraphic As Object 
Dim oLeft As Double , oTop as Double 'NumLig as Double , Largeur As Double 
Dim Taille as new com.sun.star.awt.Size 
Dim Emplacement as new com.sun.star.awt.Point 
sGraphicURL ="file:///Z:/Utilisateur JeanLuc/Documents/AUTO ENTREPRENEUR/Modeles pour Libreoffice/TamponJLD.gif"
      'msgbox("sGraphicURL = " + sGraphicURL)     
oDrawPage =ThisComponent.Sheets(0).getDrawpage() 
oGraphic =ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape") 
oGraphic.GraphicURL =sGraphicURL 
oDrawPage.add(oGraphic) 
     
Taille.width = 4000 'Dimension horizontale image (3000 = 30 millimètres)
Taille.height = 3000 'Dimension verticale image 
oGraphic.setsize(Taille) 
oLeft=2000
oTop=2000  
Emplacement.X = oLeft 
Emplacement.Y = oTop 
oGraphic.setposition(Emplacement) 

End Sub

[Bidouille]

Voici le code une fois modifié si ça peut aider quelqu'un d'autre.

Et si vous fournissiez en plus, le classeur qui intègre cette macro, cela aiderait encore mieux.

[Piaf]

Bonjour

Salut Piaf j'avais effectué une recherche (sur le site et sur google) avant de poster mais je ne trouvai pas ce que je cherchai.

Re: [Calc] Insertion d'une image dans une feuille de calcul par exemple.
A+

[Drake]

Bonsoir,

Merci Piaf je vais étudier ce code, il ressemble beaucoup à celui de CBresso.
En passant pourrais-tu me conseiller quelques lectures pour comprendre ce que sont "dispatcher" et "uno" que je rencontre souvent lors de mes recherches.

Pour répondre à Bidouille, j'avoue que je ne vois pas l’intérêt de mettre aussi le classeur.
En effet il s'agit d'une simple feuille avec un bouton d'appel de la macro.
Enfin voici quand même le tout (le classeur, le code et l'image à mettre sous C:)



a+

[Bidouille]

Pour répondre à Bidouille, j'avoue que je ne vois pas l’intérêt de mettre aussi le classeur.

Et l'intérêt de mettre [Résolu] ?

[Churay]

Pour répondre à Bidouille, j'avoue que je ne vois pas l’intérêt de mettre aussi le classeur.

Parce qu'il y a des débutants qui pourraient avoir besoin d'un pack fichier+macro(s) (pour mémoire : le forum est un lieu d'entr'aide)

[Drake]

Et l'intérêt de mettre [Résolu] ?

Je pensai mettre résolu apres avoir obtenu une réponse à la question concernant "dispatcher" et "uno".
Mais finalement je vais ouvrir un autre post.

Parce qu'il y a des débutants qui pourraient avoir besoin d'un pack fichier+macro(s) (pour mémoire : le forum est un lieu d'entr'aide)

Certes !

Ciao