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

Discussions et questions sur tout ce qui concerne la programmation tous langages et tous modules confondus.

Modérateur: Vilains modOOs

Règles du forum
:alerte: Balisage obligatoire dans cette section !
Aidez-nous à vous aider au mieux en balisant correctement votre question : reportez-vous sur les règles de cette section avant de poster !

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

Messagepar Solaris » 17 Nov 2019 00:28


La modération 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   AgrandirRéduire
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
Dernière édition par Solaris le 17 Nov 2019 23:49, édité 1 fois.
Libre office 5.0.5.2 (par obligation)
Windows 7 Professionnel
Solaris
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 96
Inscrit le : 02 Août 2017 22:55

Re: [Calc] Coller vers un autre fichier

Messagepar Mobydick_62 » 17 Nov 2019 11:33

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/viewtopic.php?f=15&t=6371

Et pour trouver la première ligne vide :
https://forum.openoffice.org/fr/forum/viewtopic.php?f=8&t=56391&p=304927&hilit=cellule+libre#p304927

Et aussi (a adapter).

Code : Tout sélectionner   AgrandirRéduire
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   AgrandirRéduire
'___________________________________________________________________________________
'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
Libre Office Version: 5.4.4.2 (x64)
SE Windows 10
Avatar de l’utilisateur
Mobydick_62
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 61
Inscrit le : 07 Avr 2011 13:04
Localisation : Vendée (France)

Re: [Calc] Coller vers un autre fichier

Messagepar Solaris » 17 Nov 2019 19:43

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   AgrandirRéduire
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
Pièces jointes
Capture.PNG
Libre office 5.0.5.2 (par obligation)
Windows 7 Professionnel
Solaris
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 96
Inscrit le : 02 Août 2017 22:55

Re: [Calc] Coller vers un autre fichier

Messagepar luky-luke » 17 Nov 2019 20:32

Bonjour
Déclaration de toute les variables, c'est important.
Code : Tout sélectionner   AgrandirRéduire
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
AOO 4.1.3 et LibO 5.3.7.2 Ubuntu 16.04 LTS et Debian 9
Xray ne tient pas lieu de tout, mais une pratique sans Xray ne vaut pas grand chose
Avatar de l’utilisateur
luky-luke
InconditiOOnnel
InconditiOOnnel
 
Message(s) : 915
Inscrit le : 27 Nov 2010 01:17
Localisation : gâtine deux-sèvrienne

Re: [Calc] Coller vers un autre fichier

Messagepar Solaris » 17 Nov 2019 21:35

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 !
Dernière édition par Solaris le 17 Nov 2019 22:11, édité 2 fois.
Libre office 5.0.5.2 (par obligation)
Windows 7 Professionnel
Solaris
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 96
Inscrit le : 02 Août 2017 22:55

Re: [Calc] Coller vers un autre fichier

Messagepar joel275 » 17 Nov 2019 21:55

Bonsoir,

as-tu testé si "NomDocExt " existe bien avec:
Code : Tout sélectionner   AgrandirRéduire
VF = FileExists(NomDocExt)

qui te renverras vrai ou faux selon que ton fichier existe ou pas à l'adresse indiquée?

A plus.
OpenOffice 4.1.2 LibreOffice 6-2-8-2 Windows 8.1
joel275
PassiOOnné
PassiOOnné
 
Message(s) : 746
Inscrit le : 10 Jan 2009 09:05

Re: [Calc] Coller vers un autre fichier

Messagepar Solaris » 17 Nov 2019 22:12

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   AgrandirRéduire
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!
Libre office 5.0.5.2 (par obligation)
Windows 7 Professionnel
Solaris
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 96
Inscrit le : 02 Août 2017 22:55

Re: [Calc] Coller vers un autre fichier

Messagepar luky-luke » 17 Nov 2019 22:35

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   AgrandirRéduire
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   AgrandirRéduire
oCellVide = MesZonesVides(0).StartRow ' Première cellule vide

Après
Code : Tout sélectionner   AgrandirRéduire
oCellVide = MesZonesVides(Ubound(MesZonesVide()).StartRow ' Dernière cellule vide
 

Cordialement
Luke
AOO 4.1.3 et LibO 5.3.7.2 Ubuntu 16.04 LTS et Debian 9
Xray ne tient pas lieu de tout, mais une pratique sans Xray ne vaut pas grand chose
Avatar de l’utilisateur
luky-luke
InconditiOOnnel
InconditiOOnnel
 
Message(s) : 915
Inscrit le : 27 Nov 2010 01:17
Localisation : gâtine deux-sèvrienne

Re: [Calc] Coller vers un autre fichier

Messagepar Solaris » 17 Nov 2019 23:13

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   AgrandirRéduire
oRange = maFeuille.Sheets(0).getCellRangeByName("A2:AHP2") 'la zone à copier


Code : Tout sélectionner   AgrandirRéduire
        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   AgrandirRéduire
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   AgrandirRéduire
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: 
Pièces jointes
Capture.PNG
Libre office 5.0.5.2 (par obligation)
Windows 7 Professionnel
Solaris
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 96
Inscrit le : 02 Août 2017 22:55


Retour vers Macros et API

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : MSN [Bot] et 5 invité(s)