Forum OpenOffice LibreOffice NeoOffice

Code : Tout sélectionner

Global maLigne as Integer 'Variable utilis&e un peu partout :-)
Option Explicit

Sub InsererLigne()
'Insérer une ligne avant la fin du tableau et recopie des formules dans la plage de destination
dim monDoc as Object, maFeuille as Object
dim maPlage as Object, maCellule as Object

	monDoc = ThisComponent      'le classeur courant
	maFeuille = monDoc.Sheets.getByName("Facture")   'Accès à la feuille facture
	
	RechercheTexte'Recherche la position du signe ++ dans le tableau
   
	maFeuille.Rows.insertByIndex(maLigne, 1)   'Insertion d'une ligne avant celle trouvée
	maPlage = maFeuille.getCellRangeByName("D29:K29") 'Plage à Copier, 1ère ligne masquée dans le tableau
   	maCellule = maFeuille.getCellByPosition(3, maLigne)'Cellule de destination
    maFeuille.copyrange(maCellule.cellAddress, maPlage.rangeAddress)'Copie de la formule
    monDoc.currentController.Select(maCellule)'place le curseur sur la cellule de destination
    
    RechercheTexte'Recherche à nouveau le signe ++ pour attribuer la nouvelle position à la variable maLigne
End Sub

Code : Tout sélectionner

Option Explicit

Sub RechercheTexte  'Recherche le signe ++ pour ecrire dans la variable maLigne sa position dans la feuille calc

dim laRecherche as Object, leTrouve as Object, maCellule as Object, maFeuille as Object, monDoc as Object

	monDoc = ThisComponent      'ThisComponent représente le classeur courant
	maFeuille = monDoc.Sheets.getByName("Facture")   'Accès à la feuille facture
	laRecherche = maFeuille.createSearchDescriptor      'Création d'un outil de recherche sur cette feuille
	
   	with laRecherche         'Définition des critères de recherche
		.SearchString = "++"
		.SearchByRow = true
		.SearchWords = false
	end with
	
	leTrouve = maFeuille.findFirst(laRecherche) 'Lancement de la recherche
	
	if isnull(leTrouve) then
		msgbox "La recherche a échoué, il faut écrire ++ dans la dérnière ligne du tableau"
	else
	   	maLigne = leTrouve.CellAddress.Row
    '	MsgBox("Valeur de la ligne ou se trouve le signe ++..." & chr(13) & maLigne & chr(13), OK)
    end if
End Sub

Code : Tout sélectionner

Sub ReinitialiserFacture

dim monDoc as Object, maFeuille as Object
dim maZoneA as Object, maZoneB as Object
dim gomme as Long
dim maCellule as Object

	monDoc = ThisComponent      'ThisComponent représente le classeur courant
	maFeuille = monDoc.Sheets.getByName("Facture")   'Accès à la feuille facture

	If maLigne = 43 Then
		'MsgBox("Pas de ligne à supprimer",OK)
	Else	
		RechercheTexte
		maFeuille.Rows.removeByIndex(42,maLigne-43)
		RechercheTexte   
	End If
	
	Rem efface le contenu des cellules avant la ligne 42 jusqu à la ligne 29
	maZoneA = maFeuille.getCellRangeByName("D30:H43")'Zone de cellule ou se trouve les désignation, etc...
	maZoneB = maFeuille.getCellRangeByName("H14:H18")'efface le nom du destinataire
	
	gomme = com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.VALUE
	
	maZoneA.clearContents(gomme)
	maZoneB.clearContents(gomme)
	
   	maCellule = maFeuille.getCellRangeByName("D31")'Cellule de destination
	monDoc.currentController.Select(maCellule)'place le curseur sur la cellule de destination
End Sub

Code : Tout sélectionner

Sub Imprime

dim ZoneImpression(0) as new com.sun.star.table.CellRangeAddress
dim monDoc as Object, document as Object
dim maFeuille as Object, maZone as Object, maZone1 as Object

	RechercheTexte
	monDoc = ThisComponent
	maFeuille = monDoc.Sheets.getByName("Facture")
			
	'Définition d'une Zone d'impression
	ZoneImpression(0).sheet = 0 '1ere feuille
	ZoneImpression(0).startcolumn = 2 'Colonne C
	ZoneImpression(0).startrow = 3 ' avant Ligne 4
	ZoneImpression(0).endcolumn = 9 ' Colonne J
	ZoneImpression(0).endrow = maLigne+12 ' 
	maFeuille.SetPrintAreas(ZoneImpression()) 
	
	'Définition de l'entete de chaque page
	maZone = maFeuille.getCellRangeByName("C4:J28")
	maFeuille.TitleColumns = maZone.RangeAddress
	maFeuille.PrintTitleColumns = True
	maFeuille.TitleRows = maZone.RangeAddress
	maFeuille.PrintTitleRows = True
	
	'Définition des paramètres d'imprimante
Dim args1(0) as New com.sun.star.beans.PropertyValue
	args1(0).Name = "Name"
	args1(0).Value = "hp deskjet 840c series"
'	args1(1).Name = "PaperFormat"
'	args1(1).Value = com.sun.star.view.PaperFormat.A4
'	args1(2).Name = "PaperOrientation"
'	args1(2).Value = com.sun.star.view.PaperOrientation.PORTRAIT
'	args1(3).Name = "Sort"	'Sort; set to TRUE to print sorted copies. This is useful only if CopyCount is
							'greater than 2. With Sort set to TRUE, the copies are printed in order.
							'These properties apply to the print job. There is another set of properties used to
							'configure the printer itself.
'	args1(3).Value = FALSE
   	monDoc.setPrinter(args1()) 
	
'Définition du nb de copies, assemblage des impressions
dim args3(0) as new com.sun.star.beans.PropertyValue
	args3(0).Name = "CopyCount"'"Copies"
	args3(0).Value = 2
	'args3(1).Name = "Selection"
	'args3(1).Value = false
'	args3(1).Name = "Collate"
'	args3(1).Value = true
	
	monDoc.Print(args3())
End Sub

Code : Tout sélectionner

Sub NouveauDocCalc

Dim monDoc as Object
Dim dispatcher as Object
Dim args1(0) as new com.sun.star.beans.PropertyValue
Dim args2(5) as new com.sun.star.beans.PropertyValue

	rem ----------------------------------------------------------------------
	rem get access to the document
	monDoc = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

	rem ----------------------------------------------------------------------
	args1(0).Name = "ToPoint"'Position de la plage de copie
	args1(0).Value = "$C$4:$J$150"

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

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

	rem---------------------------------------------------------------------- Ouvre un nouveau doc calc
	monDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Array())
	monDoc = StarDesktop.CurrentFrame

	args1(0).Name = "ToPoint"'Position de la cellule de destination
	args1(0).Value = "$C$4"
	dispatcher.executeDispatch(monDoc, ".uno:GoToCell", "", 0, args1())

	rem ---------------------------------------------------------------------- Collage spécial
	args2(0).Name = "Flags"
	args2(0).Value = "SVDNT"
	args2(1).Name = "FormulaCommand"
	args2(1).Value = 0
	args2(2).Name = "SkipEmptyCells"
	args2(2).Value = false
	args2(3).Name = "Transpose"
	args2(3).Value = false
	args2(4).Name = "AsLink"
	args2(4).Value = false
	args2(5).Name = "MoveMode"
	args2(5).Value = 4
	dispatcher.executeDispatch(monDoc, ".uno:InsertContents", "", 0, args2())

	rem ----------------------------------------------------------------------
	rem get access to the document
	monDoc   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	rem ----------------------------------------------------------------------
	
dim args3(0) as new com.sun.star.beans.PropertyValue
	args3(0).Name = "ToPoint"
	args3(0).Value = "$G$25"
	dispatcher.executeDispatch(monDoc, ".uno:GoToCell", "", 0, args3())
	dispatcher.executeDispatch(monDoc, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
	args4(0).Name = "SelectionOnly"
	args4(0).Value = true
	monDoc = StarDesktop.CurrentFrame
	dispatcher.executeDispatch(monDoc, ".uno:SaveAs", "", 0, args4())
'Je voulais réaliser la sauvegarde sans intervention de l'utilisateur au
'moment de l'ouverture de la boite de dial Enregister sous, mais je coince
	monDoc.close(True)
End Sub

Code : Tout sélectionner