Page 1 sur 1

[Résolu][Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 00:28
par Solaris

La modération vous a écrit: Macro pour a été supprimé de votre titre. Ce terme est inutile dans la section consacrée aux macros.

Bonsoir à tous,

J'ai une macro qui fonctionne très bien et qui me permet de copier/insérer/coller une ligne dans mon fichier. Je souhaiterais savoir s'il est possible que le "coller" se fasse dans un autre fichier (Feuille Champs du Fichier B) que le fichier source de la zone copiée (Feuille Champs du Fichier A).

Dans l'affirmative, est-il au surplus possible de la ligne soit copiée sur la première ligne vide (si la ligne 1 est remplie sachant que la colonne A est un point de repère fiable car si la colonne A est vide c'est que la ligne est vide).

Code : Tout sélectionner

Sub CopieGomme
Dim Champs As Object, Calculs As Object
Dim MaZone As Object, MaCopie As Object, Gomme As Long

   Champs = ThisComponent.sheets.getByName("Champs") 'Désignation de la feuille Champs
   Champs.Rows.insertByIndex(2,1)'1) 'Insertion ligne
   MaZone = Champs.getCellRangeByName("A2:AHP2") 'la zone à copier
   MaCopie = Champs.getCellRangeByName("A3") 'la destination de la copie
   Champs.copyRange(MaCopie.CellAddress, MaZone.RangeAddress ' la copie
   MaCopie.cellbackcolor = -1 'la couleur d'arrière plan 
     
End Sub
Je vous remercie par avance pour votre aide.

Bien cordialement

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 11:33
par Mobydick_62
Bonjour, pour la copie et collage entre deux fichiers CALC ici une source d'inspiration dans le suprême de code :
https://forum.openoffice.org/fr/forum/v ... =15&t=6371

Et pour trouver la première ligne vide :
https://forum.openoffice.org/fr/forum/v ... re#p304927

Et aussi (a adapter).

Code : Tout sélectionner

Sub RecupereCelluleVide()
 Dim oFeuille As Object
 Dim oCellule As Object
 Dim zoneVide As Variant
 Dim maZone As Object
 Dim nmrCelluleVide As Long  
 oFeuille = ThisComponent.getSheets.getByName("nomFeuille")
'Zone dans laquelle je recherche la première cellule libre
 maZone = oFeuille.getCellRangeByName("A2:A1000")
 zoneVide = maZone.queryEmptyCells.RangeAddresses
 nmrCelluleVide = zoneVide(0).StartRow
 nmrCelluleVide = nmrCelluleVide + 1
End Sub
Ou bien

Code : Tout sélectionner

 '___________________________________________________________________________________
 'Retourne la dernière ligne remplie sur la feuille
 Sub DerniereLigne()
Dim oDoc As Object , oFeuille As Object, oCurseur As Object
Dim derLigne as long
oDoc = ThisComponent
oFeuille = oDoc.getSheets.getByName("nomFeuille")
oCurseur = oFeuille.createCursor
oCurseur.gotoEndOfUsedArea( False )
 derLigne =  oCurseur.RangeAddress.EndRow+1
 End Sub

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 19:43
par Solaris
Bonsoir, je vous remercie pour vos réponses.

J'ai tenté d'avancer mais je suis bloquée par une erreur que je ne comprends. C'est probablement très simple pour vous mais malgré plusieurs tentatives et recherches et essais, je n'y arrive pas.
J'ai un classeur DONNEES1 qui a une feuille une champs. Je veux copier la ligne 2 de cette feuille champs pour la coller au niveau de la première ligne vide de la feuille Champs de la feuille DONNEES.

Je suis partie de la macro d'origine et j'ai voulu intégrer les lignes des autres macro pour compléter les actions de la mienne et je n'arrive pas à définir la zone du fichier extérieur (celui où je veux copier les données collées).

Code : Tout sélectionner

Sub CopieDansNouveauClasseur()

    Dim monDocument As Object, maFeuille As Object, maZone As Object
    Dim destination As Object, zoneAcopier As Object, lesLignes As Object
    Dim NomDocExt as String, oDoc as object, oRange as Object, aCopier as Object , oFeuille as Object
    Dim zonesVides As Variant
    Dim Zone_Ext As String
    Dim Cellule_Arrivee As Object , Liens As Object
    Dim derLigne As Long
    monDocument = Thiscomponent
    maFeuille = monDocument.sheets.getByName("Champs")
    NomDocExt = ConvertToURL("C:/users/cel.e/desktop/Rédaction/Données.ods")
    oDoc = StarDesktop.loadComponentFromURL(NomDocExt, "_blank", 0, Array() )
    oFeuille = oDoc.sheets.getByName("Champs")
    maZone = maFeuilledestination.Columns.GetByName("A")
    zonesVides = maZone.queryEmptyCells.RangeAddresses
    derLigne = zonesVides(UBound(zonesVides)).StartRow - 1
    zoneAcopier = maFeuille.GetCellRangeByPosition(0,1)
    destination = maFeuille.GetCellByPosition(0,derLigne,899,derLigne)
    maFeuille.copyRange(destination.CellAddress, zoneAcopier.RangeAddress)
    lesLignes = maFeuille.Rows
    lesLignes.RemoveByIndex(derLigne,1)
    monDocument.CalculateAll
    End Sub
Merci pour votre aide précieuse

Bonne soirée

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 20:32
par luky-luke
Bonjour
Déclaration de toute les variables, c'est important.

Code : Tout sélectionner

Dim Array(0) as new com.sun.star.beans.PropertyValue
Je regarderais également du coté des propriétés de tes variables ZoneAcopier et destination, je sens venir la prochaine erreur :wink:
Cordialement
Luke

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 21:35
par Solaris
Bonjour,

Je vous remercie, j'ai inséré votre code mais j'ai toujours le même code erreur sur la même ligne. C'est dû aux problèmes des autres lignes ? ou il y a encore un autre problème avec la même ligne ?
Compte tenu de mes faibles compétences, je procède de manière empirique et donc par ligne... afin de résoudre les problèmes un par un (quand j'y arrive!)

Merci beaucoup


Désolée en fait cette erreur était générée car j'avais changé le nom du classeur de destination pensant que c'était l'accent sur "données" qui pouvait gêner. Après l'échec du test, j'ai oublié de remettre le bon nom donc forcément la macro ne trouvait pas le fichier indiqué....

J'ai une nouvelle erreur mais je creuse le pb un peu avant de vous appeler au secours...

Avec toutes mes excuses !

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 21:55
par joel275
Bonsoir,

as-tu testé si "NomDocExt " existe bien avec:

Code : Tout sélectionner

VF = FileExists(NomDocExt)
qui te renverras vrai ou faux selon que ton fichier existe ou pas à l'adresse indiquée?

A plus.

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 22:12
par Solaris
C'était effectivement le problème car en essayant de trouver la solution j'ai tenté en changeant le nom du fichier (pour enlever les accent, pensant que cela pouvait poser problème), j'ai oublié de les remettre...
Merci!

Je n'ai plus d'erreur mais tout ne se passe pas ... Le classeur données s'ouvre mais il n'y a aucun coller qui s'y passe.

Voilà à quoi je suis arrivée

Code : Tout sélectionner

Sub CopieDansNouveauClasseur()

    Dim monDocument As Object, maFeuille As Object, maZone As Object
    Dim destination As Object, zoneAcopier As Object, lesLignes As Object
    Dim NomDocExt as String, oDoc as object, oFeuille as Object
    Dim zonesVides As Variant 
    Dim Array(0) as new com.sun.star.beans.PropertyValue
    Dim Zone_Ext As String
    Dim Cellule_Arrivee As Object , Liens As Object
    Dim derLigne As Long
    monDocument = Thiscomponent
    maFeuille = monDocument.sheets.getByName("Champs")
    NomDocExt = ConvertToURL("C:/users/ce.r/desktop/Rédaction/Données.ods")
    oDoc = StarDesktop.loadComponentFromURL(NomDocExt, "_blank", 0, Array() )
    oFeuille = oDoc.sheets.getByName("Champs")
    maZone =oFeuille.Columns.GetByName("A")
    zonesVides = maZone.queryEmptyCells.RangeAddresses
    derLigne = zonesVides(UBound(zonesVides)).StartRow - 1
    zoneAcopier = maFeuille.getCellRangeByName("A2:AHP2") 'la zone à copier
    destination = oFeuille.GetCellByPosition(0,derLigne,900,derLigne)
    maFeuille.copyRange(destination.CellAddress, zoneAcopier.RangeAddress)
    End Sub
Merci beaucoup!

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 22:35
par luky-luke
Bonjour
Solaris a écrit :Le classeur données s'ouvre mais il n'y a aucun coller qui s'y passe.
A priori il y un petit problème avec LibreOffice et le presse papier. Un lien vers un autre fil décrivant le problème Copie d'une feuille à un autre classeur
Pour la copie entre classeur il vaut mieux utiliser les propriétés GetTranferable() et InsertTranferable() Décrite par Piaf dans le suprême, le lien à été donné plus haut dans le fil.

Code : Tout sélectionner

Sub CopierZonesurFichierDistant
Dim oDocOri As Object, FeuilleOrig As Object, MaZoneOrig As Object, MaCopie As Object
Dim DestURL As String, oDocDest As Object, MaFeuilleDest As Object
Dim MaZoneTest As Object, MesZonesVide As Object, oCellVide As Long, MaCellDest As Object

oDocOri = ThisComponent
FeuilleOrig = oDocOri.Sheets.GetByName("Feuille1")
MaZoneOrig = FeuilleOrig.GetCellRangeByName("A2:C2")'La zone à copier
oDocOri.CurrentController.Select(MaZoneOrig)'Sélection de la zone à copier
MaCopie = oDocOri.CurrentController.GetTransferable() 'COPIER

Dim Args () As new com.sun.star.beans.PropertyValue

DestURL = ConvertToUrl("/adresse/DeMon/Fichier/MonFichier.ods")'Adresse du fichier destinataire
	If not FileExists(DestURL) Then
		MsgBox("Le document n'existe pas")
	Else
		oDocDest = StarDesktop.loadComponentFromURL(DestURL,"_blank",0 ,Args())'Ouverture du fichier

		MaFeuilleDest = oDocDest.Sheets.GetByName("Feuille1") 'Copier sur quelle feuille
		MaZoneTest = MaFeuilleDest.GetCellRangeByName("A1:A100") 'La zone ou trouver la première cellule vide
		MesZonesVides = MaZoneTest.QueryEmptyCells.RangeAddresses 'Les Zones de cellules vides
		oCellVide = MesZonesVides(Ubound(MesZonesVide()).StartRow ' Dernière cellule vide
		MaCellDest = MaFeuilleDest.GetCellByPosition(0,oCellVide)

		oDocDest.CurrentController.Select(MaCellDest)'Sélection de la cellule destinataire de la copie
		oDocDest.CurrentController.InsertTransferable(MaCopie)'COLLER
	End if

End Sub
 Ajout : Modification de la macro
Avant

Code : Tout sélectionner

oCellVide = MesZonesVides(0).StartRow ' Première cellule vide
Après

Code : Tout sélectionner

oCellVide = MesZonesVides(Ubound(MesZonesVide()).StartRow ' Dernière cellule vide
 
Cordialement
Luke

Re: [Calc] Coller vers un autre fichier

Publié : 17 nov. 2019 23:13
par Solaris
Merci je vais essayer !

Avec la macro de Piaf j'arrive à ça (attention j'ai modéré mes ambitions en commençant par coller mon copier sur une ligne insérée en ligne3):
j'ai une erreur ("Propriété ou méthode non trouvée" :Sheets) pour cette ligne

Code : Tout sélectionner

oRange = maFeuille.Sheets(0).getCellRangeByName("A2:AHP2") 'la zone à copier

Code : Tout sélectionner

        Option Explicit
Sub CopieDansNouveauClasseur()

    Dim monDocument As Object, maFeuille As Object, aCopier As Object
    Dim destination As Object, oRange As Object
    Dim NomDocExt as String, oDoc as object, oFeuille as Object
    Dim Array(0) as new com.sun.star.beans.PropertyValue
    Dim derLigne As Long
    monDocument = Thiscomponent
    maFeuille = monDocument.sheets.getByName("Champs")
    NomDocExt = ConvertToURL("C:/users/ce.r/desktop/Rédaction/Données.ods")
  	destination = StarDesktop.loadComponentFromURL(NomDocExt, "_blank", 0, Array() )
    oFeuille = destination.sheets.getByName("Champs")
    oRange = maFeuille.Sheets(0).getCellRangeByName("A2:AHP2") 'la zone à copier
    maFeuille.CurrentController.select(oRange) 'Sélection de la zone
    aCopier = maFeuille.CurrentController.getTransferable() 'Copie
    oFeuille.Rows.insertByIndex(2,1)'1) 'Insertion ligne
    oRange = oFeuille.Sheets(1).getCellRangeByName("A3")'Première cellule pour recopie de la zone
    oFeuille.CurrentController.select(oRange) 'Selection de la cellule
    oFeuille.CurrentController.insertTransferable(aCopier) 'Transfert des données
    End Sub
J'essaye la votre et je reviens! merci beaucoup
 Ajout : J'ai ce message d'erreur que je ne comprends pas car UBound n'est pas cité précédemment... Je joins une capture d'écran 

Code : Tout sélectionner

Sub CopierZonesurFichierDistant

Dim oDocOri As Object, FeuilleOrig As Object, MaZoneOrig As Object, MaCopie As Object
Dim DestURL As String, oDocDest As Object, MaFeuilleDest As Object
Dim MaZoneTest As Object, MesZonesVide As Object, oCellVide As Long, MaCellDest As Object

oDocOri = ThisComponent
FeuilleOrig = oDocOri.Sheets.GetByName("Champs")
MaZoneOrig = FeuilleOrig.GetCellRangeByName("A2:AHP2")'La zone à copier
oDocOri.CurrentController.Select(MaZoneOrig)'Sélection de la zone à copier
MaCopie = oDocOri.CurrentController.GetTransferable() 'COPIER

Dim Args () As new com.sun.star.beans.PropertyValue

DestURL = ConvertToUrl("C:/users/ce.r/desktop/Rédaction/Données.ods")'Adresse du fichier destinataire
   If not FileExists(DestURL) Then
      MsgBox("Le document n'existe pas")
   Else
      oDocDest = StarDesktop.loadComponentFromURL(DestURL,"_blank",0 ,Args())'Ouverture du fichier

      MaFeuilleDest = oDocDest.Sheets.GetByName("Champs") 'Copier sur quelle feuille
      MaZoneTest = MaFeuilleDest.GetCellRangeByName("A1:AHP1") 'La zone ou trouver la première cellule vide
      MesZonesVides = MaZoneTest.QueryEmptyCells.RangeAddresses 'Les Zones de cellules vides
      oCellVide = MesZonesVides(Ubound(MesZonesVide()).StartRow ' Dernière cellule vide
      MaCellDest = MaFeuilleDest.GetCellByPosition(0,oCellVide)

      oDocDest.CurrentController.Select(MaCellDest)'Sélection de la cellule destinataire de la copie
      oDocDest.CurrentController.InsertTransferable(MaCopie)'COLLER
   End if
 Ajout : ça y est j'y suis arrivée. J'ai renoncé à la sélection de la dernière ligne vide mais j'ai contourné le problème en insérant une ligne ! Puis j'enregistre mes deux documents et je ferme le fichier de destination.

Code : Tout sélectionner

Option Explicit
Sub CopierZonesurFichierDistant

Dim oDocOri As Object, FeuilleOrig As Object, MaZoneOrig As Object, MaCopie As Object
Dim DestURL As String, oDocDest As Object, MaFeuilleDest As Object
Dim MaZoneTest As Object, MesZonesVide As Object, oCellVide As Long, MaCellDest As Object

oDocOri = ThisComponent
FeuilleOrig = oDocOri.Sheets.GetByName("Champs")
MaZoneOrig = FeuilleOrig.GetCellRangeByName("A2:AHP2")'La zone à copier
oDocOri.CurrentController.Select(MaZoneOrig)'Sélection de la zone à copier
MaCopie = oDocOri.CurrentController.GetTransferable() 'COPIER

Dim Args () As new com.sun.star.beans.PropertyValue

DestURL = ConvertToUrl("C:/users/ce.ri/desktop/Rédaction/Données.ods")'Adresse du fichier destinataire
   If not FileExists(DestURL) Then
      MsgBox("Le document n'existe pas")
   Else
      oDocDest = StarDesktop.loadComponentFromURL(DestURL,"_blank",0 ,Args())'Ouverture du fichier

      MaFeuilleDest = oDocDest.Sheets.GetByName("Champs") 'Copier sur quelle feuille
      MaFeuilleDest.Rows.insertByIndex(1,1)'1) 'Insertion ligne
      oDocDest.CurrentController.Select("A3:AHP3")'Sélection de la cellule destinataire de la copie
      oDocDest.CurrentController.InsertTransferable(MaCopie)'COLLER
      ThisComponent.store(True)
   	  oDocDest.store
   	  oDocDest.close(True)
 end if
   end sub

Un grand merci à vous! :bravo: