[Résolu][Calc]Copier coller une image à partir d'une colonne

[Noonours]

Bonjour à tous.

Je souhaiterais à partir de la valeur de la cellule H5 de la feuille1 copier le contenu de deux cellules de la colonne B de la feuille2.
C'est à dire que si la valeur de H5 est 1, on copie à partir de la feuille 2 la plage B1:B2 sur la feuille 1.
si H5 = 2 , on copie feuille2.B3:B4 sur la feuille1,
si H5 = 3, on copie feuille2.B5:B6 sur la feuille1 etc etc.

J'ai réussi à le faire (voir exemple ci-dessous), mais la fonction de copier-coller ne fonctionne qu'à partir de texte dans les cellules d'origine. Si ce classeur ne contenait que du texte ou des nombres, il serait inutile de passer par macro, les fonctions de RECHERCHE de Calc seraient bien suffisantes.
Mon souci vient du fait que certaines cellules de la feuille 'source' contiennent une image qu'il faut aussi copier-coller... d'où l'obligation de passer par macro.

J'ai créé un bouton auquel est rattaché la macro.
Mon codage est probablement très approximatif, soyez indulgents, je me lance depuis peu dans la programmation en OoBasic
Voici ce que j'ai réalisé en m'inspirant de ce que j'ai glané sur ce forum, il y a certainement plus élégant:

Code : Tout sélectionner

Option Explicit

Sub CopColAvec_DataArray
Dim oDoc As Object, oSheetSource As Object, oSheetCible As Object
Dim oRangeSource As Object, oRangeCible As Object, ACopier(), oRASource, oRACible
Dim Ymax as Integer, Ymin as Integer, Y as Integer


   oDoc = thisComponent           ' Le document
   oSheetSource = oDoc.Sheets(1)  ' La feuille Source : ici Feuille 2
   oSheetCible = oDoc.Sheets(0)   ' La feuille Cible : ici Feuille 1
   
   Y =  oSheetCible.getCellRangebyName("H5").Value 'La valeur de la cellule H5 de la Feuille 1
   Ymax = (Y * 2)  -1 'La limite max de la plage à copier
   Ymin = Ymax - 1    'La limite min de la plage à copier
   
   ' La plage source 
   oRangeSource = oSheetSource.getCellRangeByPosition(1, Ymin, 1, Ymax)
   
   ' Les Données de la plage
   ACopier = oRangeSource.getDataArray
   ' Les Index de la plage
   oRASource = oRangeSource.RangeAddress
   
   ' La plage Cible redéfinie
   oRangeCible = oSheetCible.getCellRangeByName("B2:B3")

   ' on copie
   oRangeCible.setDataArray(ACopier)
End Sub

Mon fichier exemple avec quelques images Fontwork (dans la version définitive, les images seront au format png et/ou jpeg)

[Piaf]

Bonsoir
Teste en utilisant getTransferable voir : [Calc] Copier/Coller direct entre 2 feuilles ou classeurs
A tester

Code : Tout sélectionner

Option Explicit

Sub CopColAvec_DataArray
Dim oDoc As Object, oSheetSource As Object, oSheetCible As Object
Dim oRangeSource As Object, oRangeCible As Object, ACopier(), oRASource, oRACible
Dim Ymax as Integer, Ymin as Integer, Y as Integer, x as Integer
Dim CellSource as Object, CellDest as Object, Transfert as Object
	oDoc = thisComponent           ' Le document
	oSheetSource = oDoc.Sheets(1)  ' La feuille Source : ici Feuille 2
	oSheetCible = oDoc.Sheets(0)   ' La feuille Cible : ici Feuille 1

	Y =  oSheetCible.getCellRangebyName("H5").Value 'La valeur de la cellule H5 de la Feuille 1
	Ymax = (Y * 2)  -1 'La limite max de la plage à copier
	Ymin = Ymax - 1    'La limite min de la plage à copier

'	La plage source
	oRangeSource = oSheetSource.getCellRangeByPosition(1, Ymin, 1, Ymax)
'	La plage Cible
	oRangeCible = oSheetCible.getCellRangeByPosition(1,1,1,2)
	oRangeCible.clearContents(151)
	For x = 0 To 1
		CellSource = oRangeSource.getCellByPosition(0,x)
		CellDest = oRangeCible.getCellByPosition(0,x)
		If CellSource.getType() = com.sun.star.table.CellContentType.FORMULA Then
		   	ACopier = CellSource.getDataArray
		   	CellDest.setDataArray(ACopier)
		Else
			oDoc.CurrentController.select(CellSource)
			Transfert = oDoc.CurrentController.getTransferable()
			oDoc.CurrentController.select(CellDest)
			oDoc.CurrentController.insertTransferable(Transfert)
		End If
   Next x
End Sub

A+

[Noonours]

Merci Piaf pour ta réponse rapide

Ton code ne fonctionne pas chez moi, les images n'apparaissent pas... Néanmoins, je ne connaissais pas la fonction qui permettait de tester le contenu de la cellule comme étant une formule; je garde ça au chaud pour plus tard.

J'ai re-bricolé un truc en me basant sur le lien que tu m'as fourni plus haut, et je me suis inspiré d'un certain... Piaf!
Et ça fonctionne chez moi!

Code : Tout sélectionner

Sub CopColAvec_DataArray
Dim oDoc as Object, oRange as Object, aCopier as Object
Dim Y as Integer, Ymin as Integer, Ymax as Integer


   oDoc = thisComponent
    Y =  oDoc.Sheets(0).getCellRangebyName("H5").Value
    Ymax = (Y * 2)  -1 'La limite max de la plage à copier
    Ymin = Ymax - 1    'La limite min de la plage à copier
    
   oRange = oDoc.Sheets(1).getCellRangeByPosition(1,Ymin,1,Ymax) ' la zone à copier
   oDoc.CurrentController.select(oRange) 'Sélection de la zone
   aCopier = oDoc.CurrentController.getTransferable() 'Copie
   oRange = oDoc.Sheets(0).getCellRangeByName("B2") 'Première cellule pour recopie de la zone
   oDoc.CurrentController.select(oRange) 'Selection de la cellule
   oDoc.CurrentController.insertTransferable(aCopier) 'Transfert des données
   
End Sub

Merci pour tout Piaf

A+

[Piaf]

Bonsoir
Malgrés le [Résolu]

Ton code ne fonctionne pas chez moi

Excuse je n'avais testé sous LibO.
Après teste avec ma version de LibO (Version: 4.3.6.2) la macro envoyée ne copie effectivement pas les images.
Ta macro les copie mais recopie la formule au lieu de la valeur.
Sous LibO pour que la macro, recopie soit les images soit la valeur de la formule, remplacer

Code : Tout sélectionner

oDoc.CurrentController.select(CellSource)

par

Code : Tout sélectionner

oDoc.CurrentController.select(oRangeSource)

Ca le fait aussi pour AOO.

Code : Tout sélectionner

Sub CopColAvec_DataArray
Dim oDoc As Object, oSheetSource As Object, oSheetCible As Object
Dim oRangeSource As Object, oRangeCible As Object, ACopier(), oRASource, oRACible
Dim Ymax as Integer, Ymin as Integer, Y as Integer, x as Integer
Dim CellSource as Object, CellDest as Object, Transfert as Object
	oDoc = thisComponent           ' Le document
	oSheetSource = oDoc.Sheets(1)  ' La feuille Source : ici Feuille 2
	oSheetCible = oDoc.Sheets(0)   ' La feuille Cible : ici Feuille 1

	Y =  oSheetCible.getCellRangebyName("H5").Value 'La valeur de la cellule H5 de la Feuille 1
	Ymax = (Y * 2)  -1 'La limite max de la plage à copier
	Ymin = Ymax - 1    'La limite min de la plage à copier

'	La plage source
	oRangeSource = oSheetSource.getCellRangeByPosition(1, Ymin, 1, Ymax)
'	La plage Cible
	oRangeCible = oSheetCible.getCellRangeByPosition(1,1,1,2)
	oRangeCible.clearContents(151)
	For x = 0 To 1
		CellSource = oRangeSource.getCellByPosition(0,x)
		CellDest = oRangeCible.getCellByPosition(0,x)
		If CellSource.getType() = com.sun.star.table.CellContentType.FORMULA Then
		   	ACopier = CellSource.getDataArray
		   	CellDest.setDataArray(ACopier)
		Else
			oDoc.CurrentController.select(oRangeSource)
			Transfert = oDoc.CurrentController.getTransferable()
			oDoc.CurrentController.select(CellDest)
			oDoc.CurrentController.insertTransferable(Transfert)
		End If
   Next x
End Sub

Encore un comportement différent entre les deux suites
A+