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.
Je regarderais également du coté des propriétés de tes variables
ZoneAcopier et
destination, je sens venir la prochaine erreur
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:
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èsCode : 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! |