[Résolu][Calc]Insertion et Copie d'une ligne

[WD_And_Co]

Bonjour le Forum

Je débute avec Calc, j'ai utilisé l'enregistreur pour automatiser l'insertion et copie d'une ligne, mais cela ne fonctionne pas comme voulu. (Je n'ai pas trouvé l'insertion de la ligne copier)
Le but, Insert une nouvelle ligne 3, Copier la ligne 4, Coller sur la ligne 3, Effacer C3:D3

Je joint un fichier ou la deuxième feuille correspond au résultat escompté par rapport à la première après l'utilisation du Bouton "Nouvelle Ligne".

Un truc aussi, comment ne plus avoir à activer les macros à chaque ouverture.

D'avance merci.

[OOotremer971]

Bonjour,

Tu as affecté ta macro à l'événement "Touche enfoncée" :

WD_And_Co(1).png

alors qu'il faut l'affecter à l'événement exécuter l'action :

WD_And_Co(2).png

La ligne est bien insérée mais je ne suis pas sûr que se soit les bonnes valeurs qui sont copiées. Il faudra peut-être réenregistrer ta macro pour voir.

@+

[WD_And_Co]

Bonjour le Forum

Merci OOotremer971, j'ai réaffecter le bouton, j'ai bien une copie bizarre, mais je n'ai pas d'insertion de ligne.

[OOotremer971]

Tu devrais essayer de réenregistrer ta macro car j'ai souvenir que l'insertion de ligne fonctionne bien avec l'enregistreur. Sinon tu peux tester ce code pour insérer une ligne :

Code : Tout sélectionner

Sub InsertLigne
feuille =Thiscomponent.Sheets.GetByName("Saisie")
feuille.Rows.InsertByIndex(2,1)
End Sub

@+

[WD_And_Co]

Bonsoir le Forum

Je pense avoir réussi voir le fichier joint. L'enregistreur est plus ardu que celui d'Excel, enfin je trouve.
Si quelqu'un a la solution pour éviter le message activer les macros, je suis preneur.

[OOotremer971]

Si quelqu'un a la solution pour éviter le message activer les macros, je suis preneur.

A l'ouverture du fichier ? A tes risques et périls : menu Outils>>Options>>Sécurité>>Sécurité des macros il faut cocher le bouton radio faible au lieu de moyen. Mais si tu télécharges par mégarde un fichier contenant une macro malveillante, elle sera exécutée à ton insu sans même que tu saches que le fichier contenait une macro. Personnellement je ne prendrais pas ce risque.

Je viens de tester ton fichier, et petite bizarrerie, alors que je travaillais sur un autre fichier, dans lequel je venais d'effectuer un copier/coller d'une colonne, le fait d'appuyer sur le bouton de ta macro a coller le contenu du presse papier dans ton fichier.
J'ai bien l'impression qu'il faudra que tu envisages d'écrire une macro spécifique pour ton copier/coller pour éviter ce genre de soucis si tu y es confronté.

@+

[WD_And_Co]

Bonjour le Forum

En effet, il faudrait vider le cache du Copier Coller, avant, enfin je pense. Votre avis.
Hier soir tout fonctionné bien pourtant.

Petit rappel : Cette macro doit, Insérer une nouvelle ligne entre la 2 et 3, puis Copier la 4, Coller sur la 3, Effacer C3:D3 et se Placer sur A3.
Une question bête, dans Excel il y a : Insérer la ligne copier, de mémoire, y a t'il la même chose dans Libre Office ?

Code : Tout sélectionner

REM  *****  BASIC  *****



sub NouvelleLigne
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:InsertRowsBefore", "", 0, Array())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args4(5) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Flags"
args4(0).Value = "A"
args4(1).Name = "FormulaCommand"
args4(1).Value = 0
args4(2).Name = "SkipEmptyCells"
args4(2).Value = true
args4(3).Name = "Transpose"
args4(3).Value = false
args4(4).Name = "AsLink"
args4(4).Value = false
args4(5).Name = "MoveMode"
args4(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "ToPoint"
args5(0).Value = "$C$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args5())

rem ----------------------------------------------------------------------
dim args6(0) as new com.sun.star.beans.PropertyValue
args6(0).Name = "Flags"
args6(0).Value = "A"

dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args6())

rem ----------------------------------------------------------------------
dim args7(0) as new com.sun.star.beans.PropertyValue
args7(0).Name = "ToPoint"
args7(0).Value = "$D$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args7())

rem ----------------------------------------------------------------------
dim args8(0) as new com.sun.star.beans.PropertyValue
args8(0).Name = "Flags"
args8(0).Value = "A"

dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args8())

rem ----------------------------------------------------------------------
dim args9(0) as new com.sun.star.beans.PropertyValue
args9(0).Name = "ToPoint"
args9(0).Value = "$A$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args9())


end sub

Si il y a plus simple je suis preneur.

D'avance merci.

[Piaf]

Bonjour
A tester

Code : Tout sélectionner

Sub InsertLigne
Dim oDoc as Object, Feuille as Object, maZone as Object, aCopier as Object
Dim gomme as Long, oCells
	oDoc = thisComponent
	Feuille = oDoc.Sheets.GetByName("Saisie")
	maZone = Feuille.getCellRangeByName("A3:L3")
	Feuille.Rows.InsertByIndex(2,1)
	oDoc.CurrentController.select(maZone)
	aCopier = oDoc.CurrentController.getTransferable()
	maZone = Feuille.getCellRangeByName("A3")
	oDoc.CurrentController.select(maZone)
	oDoc.CurrentController.insertTransferable(aCopier)
	maZone = Feuille.getCellRangeByName("C3:D3")
	gomme = com.sun.star.sheet.CellFlags.VALUE
	maZone.clearContents(gomme)
	oCells = ThisComponent.CreateInstance("com.sun.star.sheet.SheetCellRanges")
	oDoc.CurrentController.Select(oCells)
	Feuille.rows.getByIndex(2).OptimalHeight = True
End Sub

A+

[rollmops]

Bonjour,

En assemblant mieux le code fourni par le dispatcher :

Code : Tout sélectionner

sub NouvelleLigne
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    dim args2(5) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "Flags"
    args2(0).Value = "A"
    args2(1).Name = "FormulaCommand"
    args2(1).Value = 0
    args2(2).Name = "SkipEmptyCells"
    args2(2).Value = true
    args2(3).Name = "Transpose"
    args2(3).Value = false
    args2(4).Name = "AsLink"
    args2(4).Value = false
    args2(5).Name = "MoveMode"
    args2(5).Value = 4
    dim args3(0) as new com.sun.star.beans.PropertyValue
    args3(0).Name = "Flags"
    args3(0).Value = "A" 
   args1(0).Value = "$A$3"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    dispatcher.executeDispatch(document, ".uno:InsertRowsBefore", "", 0, Array())
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
    dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args2())
    args1(0).Value = "$C$3"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args3())
    args1(0).Value = "$D$3"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args3())
    args1(0).Value = "$A$3"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
end sub

[WD_And_Co]

Bonjour le Forum

Merci Rollmops, mais votre solution ne copie pas la ligne 4, un peu comme le code de l'enregistreur.

Merci Piaf, votre code fonctionne très bien, comment le rendre compatible à d'autres feuilles ? Feuille = ThisComponent.CurrentController.ActiveSheet.Name ne fonctionne pas

Code : Tout sélectionner

Sub NouvelleLigne
Dim oDoc as Object, Feuille as Object, maZone as Object, aCopier as Object
Dim gomme as Long, oCells
   oDoc = thisComponent
  Rem Feuille = oDoc.Sheets.GetByName("Saisie Eau Froide")
  Feuille = ThisComponent.CurrentController.ActiveSheet.Name
   maZone = Feuille.getCellRangeByName("A3:N3")
   Feuille.Rows.InsertByIndex(2,1)
   oDoc.CurrentController.select(maZone)
   aCopier = oDoc.CurrentController.getTransferable()
   maZone = Feuille.getCellRangeByName("A3")
   oDoc.CurrentController.select(maZone)
   oDoc.CurrentController.insertTransferable(aCopier)
   maZone = Feuille.getCellRangeByName("C3:D3")
   gomme = com.sun.star.sheet.CellFlags.VALUE
   maZone.clearContents(gomme)
   oCells = ThisComponent.CreateInstance("com.sun.star.sheet.SheetCellRanges")
   oDoc.CurrentController.Select(oCells)
   Feuille.rows.getByIndex(2).OptimalHeight = True
End Sub

Encore merci.

[Dude]

comment le rendre compatible à d'autres feuilles ? Feuille = ThisComponent.CurrentController.ActiveSheet.Name ne fonctionne pas

C'est sûr que d'essayer des instructions au pifomètre ne fonctionnera pas.
Faire un minimum de recherche sur comment récupérer le nom de la feuille courante s’avérerait plus efficace.

[WD_And_Co]

Bonjour le Forum

Merci, pour cette remarque le pifomètre est issu de https://forum.openoffice.org/fr/forum/v ... 15&t=11870 mais je persévère.

[Dude]

Je t'invite fortement à utiliser XRay pour comprendre.
Tu déclares Feuille comme objet alors que tu veux récupérer une chaîne.
N'y vois-tu pas une contradiction ?

[luky-luke]

Bonjour
Le nom de la feuille n'as aucune utilité dans la code de Piaf.
Pour ton problème il suffit de récupérer la feuille active

Code : Tout sélectionner

Feuille = ThisComponent.CurrentController.ActiveSheet

devrait suffire...
Si tu souhaite récupérer le nom de la feuille active

Code : Tout sélectionner

Feuille = ThisComponent.CurrentController.ActiveSheet
NomFeuille = Feuille.CodeName

Cordialement
Luke

[WD_And_Co]

Bonjour le Forum.

Merci beaucoup Luky-Luke, cela fonctionne parfaitement.
Dans le code d'origine de Piaf, il y avait : "Feuille = oDoc.Sheets.GetByName("Saisie")" cela n'est pas compatible à l'utilisation de ce code sur plusieurs feuilles, je pense.

Encore merci.

[WD_And_Co]

Bonjour le Forum

Juste pour apprendre encore, voici votre code mis au gout du jour.
Que faut il modifier et surtout comment, pour que la dernière ligne soit copier après cette dernière, et que le curseur se positionne sur la cellule (A:NouvelleDerniereLigne)

D'avance merci.

Code : Tout sélectionner

Sub NouvelleLigne
Dim oDoc as Object, Feuille as Object, maZone as Object, aCopier as Object
Dim gomme as Long, oCells
   oDoc = thisComponent
   Feuille = ThisComponent.CurrentController.ActiveSheet
   NomFeuille = Feuille.CodeName
   maZone = Feuille.getCellRangeByName("A5:N5")
   Feuille.Rows.InsertByIndex(4,1)
   oDoc.CurrentController.select(maZone)
   aCopier = oDoc.CurrentController.getTransferable()
   maZone = Feuille.getCellRangeByName("A5")
   oDoc.CurrentController.select(maZone)
   oDoc.CurrentController.insertTransferable(aCopier)
   maZone = Feuille.getCellRangeByName("C5:D5")
   gomme = com.sun.star.sheet.CellFlags.VALUE
   maZone.clearContents(gomme)
   oCells = ThisComponent.CreateInstance("com.sun.star.sheet.SheetCellRanges")
   oDoc.CurrentController.Select(oCells)
   Feuille.rows.getByIndex(5).OptimalHeight = True
End Sub

[Piaf]

Bonjour

soit copier après cette dernière, et que le curseur se positionne sur la cellule (A:NouvelleDerniereLigne)

Une petite recherche peut-être queryEmptyCells
A+

[WD_And_Co]

Bonjour le Forum

Merci pout l'info, à tout hasard : queryEmptyRows n'existe pas ?

Bon je me lance.

Code : Tout sélectionner

maZone = Feuille.getCellRangeByName("A5:N5")

devient si je veux la dernière ligne

Code : Tout sélectionner

maZone = Feuille.getCellRangeByName(queryEmptyCells-14 : queryEmptyCells)

[Piaf]

Re

Dans le code d'origine de Piaf, il y avait : "Feuille = oDoc.Sheets.GetByName("Saisie")" cela n'est pas compatible à l'utilisation de ce code sur plusieurs feuilles

Où est-il précisé dans ta question d'origine, que la macro doit pouvoir s'appliquer à plusieurs feuilles ?

à tout hasard : queryEmptyRows n'existe pas ?

Pas à ma connaissance.

Code : Tout sélectionner

maZone = Feuille.getCellRangeByName(queryEmptyCells-14 : queryEmptyCells)

Je ne pense pas que tu ais trouvé ce genre de code dans les liens proposés par la recherche.
Un petit exemple sur ton fichier.

Code : Tout sélectionner

Option Explicit
Sub InsertLigne
Dim oDoc as Object, Feuille as Object, maZone as Object, maCell as Object
Dim zonesVides as Variant, y as Long, oCells
	oDoc = thisComponent
	Feuille = oDoc.CurrentController.ActiveSheet
	maZone = Feuille.getCellRangeByName("A3:A200")
	zonesVides = maZone.queryEmptyCells.RangeAddresses
	y = zonesVides(0).StartRow
	Feuille.Rows.InsertByIndex(y - 1,1)
	maZone = Feuille.getCellRangeByName("A" & y - 1 & ":L" & y - 1)
	maCell = Feuille.getCellRangeByName("A" & y)
	Feuille.copyRange(maCell.CellAddress, maZone.RangeAddress)
	Feuille.getCellRangeByName("B" & y - 1).Formula = "=A" & y - 1 & "-A" & y
	Feuille.getCellRangeByName("A" & y + 1).Formula = "=A" & y
	Feuille.getCellRangeByName("B" & y).Formula = "=A" & y & "-A" & y + 1
	oDoc.CurrentController.select(maCell)
	oCells = ThisComponent.CreateInstance("com.sun.star.sheet.SheetCellRanges")
	oDoc.CurrentController.Select(oCells)
End Sub

A+

[WD_And_Co]

Bonjour le Forum

Merci, j'ai mis ces codes dans ma nouvelle boite à macros, encore merci.