Forum OpenOffice LibreOffice NeoOffice

Code : Tout sélectionner

'Mise en majuscule des cellules
Function MiseEnMajuscule(oTexte As String) As String
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   MiseEnMajuscule = oCalc.callFunction("PROPER", array(oTexte))
End Function

Code : Tout sélectionner

Sub Main
Dim oDlg As Object, oDoc as Object, maFeuille as Object
	oDoc = thisComponent
	maFeuille = oDoc.Sheets.getByName("Feuille1")
	DialogLibraries.LoadLibrary("Standard")
	oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
	If oDlg.Execute = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
		oDlg.getControl("txtNom").Text = UCase(oDlg.getControl("txtNom").Text)
		maFeuille.getCellRangeByName("A2").String = oDlg.getControl("txtNom").Text
		oDlg.getControl("txtPrenom").Text = NomPropre(oDlg.getControl("txtPrenom").Text)
		maFeuille.getCellRangeByName("B2").String = oDlg.getControl("txtPrenom").Text
	End If	
oDlg.dispose()
End Sub

Function NomPropre(oTexte As String) As String
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   NomPropre = oCalc.callFunction("PROPER", array(oTexte))
End Function

Code : Tout sélectionner

Sub Main
	MiseEnMajuscule("D6")
End Sub

Function MiseEnMajuscule(NomDeCellule as String) As String
Dim MonDoc as Object, oCalc as Object, oTexte as String
   MonDoc = ThisComponent
   oTexte = MonDoc.Sheets(0).getCellRangeByName(NomDeCellule).String
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   MonDoc.Sheets(0).getCellRangeByName(NomDeCellule).String = oCalc.callFunction("PROPER", array(oTexte))
End Function

Code : Tout sélectionner

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

Option Explicit
Const dateFormat = "dd/mm/yy"
Const findAll = "+" 
Const findEmpty = "-"
Const firstColumn = 1 'première colonne (B)
Const lastColumn = 16 'dernière colonne (Q)
Const firstRow = 5 'première ligne (6)
Const maxRow = 9999 'dernière ligne (10000)!
Const ddf = 9 'date (J)
Const dde = 5 'date (F)
Const dateControl="com.sun.star.awt.UnoControlDateField"
Const listControl="com.sun.star.awt.UnoControlListBox"

Dim theSheet As Object 
Dim theDialog As Object
Dim isDisplay As Boolean
Dim theControls(0 To lastColumn) As Object
Dim theDates() As Object
Dim theLists() As Object
Dim searchColumn%
Dim searchString$
Dim searchRange As Object
Dim searchDescriptor As Object
Dim searchResult As Object
Dim foundRow As Integer

Sub NewFileOnClick(event)
	Dim s As String
	s=Mid(event.source.model.name,3) 'Voir Module Notes
	theSheet=ThisComponent.sheets.GetByName(s)
	theDialog=GetSearchDialog
	InitDialog
	theControls(0).visible=false
	theDialog.Execute
End Sub
	
Sub InitDialog
	Dim control As Object, column As String
	For Each control In theDialog.controls
		column=control.model.name
		If Val(column)>0 Or Left(column,1)="0" Then theControls(Val(column))=control
	Next control	
	theDates=Array(theControls(ddf))
	Dim a() As String
	a=Split(theControls(0).text,"*")
	theControls(0).text=a(0)+findAll+a(1)+findEmpty+a(2)
End Sub

Sub ReadFile(row%)
	Dim control As Object, column As Integer, cell As Object
	For column=firstColumn To lastColumn
		cell=theSheet.GetCellByPosition(column,row)
		control=theControls(column)
		'on distingue les contrôles éditables et les listes de choix
		If control.SupportsService(listControl) Then
			control.SelectItem cell.string,true
		ElseIf control.SupportsService(dateControl) Then
			ReadDate cell,control
		Else
			control.text=cell.string
		End If
	Next column
End Sub

Sub EmptyDialog
	Dim control As Object
	Dim column As Integer	
	For column=firstColumn To lastColumn
		With theControls(column)
			If .SupportsService(listControl) Then
				.SelectItem " ",true
			Else
				.text=""
			End If
		End With
	Next column
End Sub	
	
Function FoundAt(row)
	Dim cell As Object		

	cell=theSheet.GetCellByPosition(searchColumn,row)
	Select Case searchString
		Case findAll
			FoundAt=true
		Case findEmpty
			FoundAt=(cell.String="")
		Case Else
			FoundAt=Instr(cell.String,searchString)
	End Select
End Function

Sub WriteToCurrentRow
	WriteToRowNumber foundRow
End Sub

Sub WriteToNewRow
	Dim row
	
	row=GetNewRow
	theSheet.GetCellByPosition(0,row).value=GetNewFileNumber
	WriteToRowNumber row
End Sub

Sub WriteToRowNumber(n As Integer)
	Dim control As Object, column As Integer, cell As Object, theDate As Long
	
	For column=firstColumn To lastColumn
		cell=theSheet.GetCellByPosition(column,n)
		control=theControls(column)
		'on distingue les types de contrôle
		With control
			If .SupportsService(listControl) Then
				cell.string=.SelectedItem
			ElseIf .SupportsService(dateControl) Then
				WriteDate control,cell
			Else
				cell.string=.text
			End If
		End With
	Next column
	theDialog.EndExecute
End Sub
'-----------------------------------------------------------------------
Sub Main
   MiseEnMajuscule("D6")
End Sub

Function MiseEnMajuscule(NomDeCellule as String) As String
Dim MonDoc as Object, oCalc as Object, oTexte as String
   MonDoc = ThisComponent
   oTexte = MonDoc.Sheets(0).getCellRangeByName(NomDeCellule).String
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   MonDoc.Sheets(0).getCellRangeByName(NomDeCellule).String = oCalc.callFunction("PROPER", array(oTexte))
End Function
'-------------------------------------------------------------------------------------------------------------------

Sub ReadDate(cell As Object, control As Object)
	control.text=cell.string
End Sub

Sub WriteDate(control As Object, cell As Object)
	dim s As String	
	s=control.text
	If s="" Then
		cell.string=""
	Else
		cell.value=CDate(Join(Split(s,"/"),"."))
	End If
End Sub

Sub DateControlToCell(control As String, cell As Object)
	Dim strDate	
	strDate=control'.text
	If strDate="" Then
		cell.string=""
	Else
		strdate=Join(Split(strDate,"/"),".")
		cell.value=CDate(strDate)
	End If
End Sub

Sub CallSearchDisplay
   SetSearchDisplay(True)
End Sub

Function GetNewRow As Integer
	GetNewRow=theSheet.GetCellByPosition(0,3).value+firstRow
End Function

Function GetNewFileNumber As Integer
	GetNewFileNumber=theSheet.GetCellByPosition(0,4).value+1
End Function

Function GetSearchDialog
	DialogLibraries.loadLibrary("Standard")
	GetSearchDialog = CreateUnoDialog(DialogLibraries.Standard.FileEditionDialog01)
End Function

Sub DeselectSpace(event As Object)
	With event.source
		If .selectedItem=" " Then .SelectItem " ",false
	End With
End Sub	

Code : Tout sélectionner

	For column=firstColumn To lastColumn
		cell=theSheet.GetCellByPosition(column,n)
		control=theControls(column)
		'on distingue les types de contrôle
		With control
			If .SupportsService(listControl) Then
				cell.string=.SelectedItem
			ElseIf .SupportsService(dateControl) Then
				WriteDate control,cell
			Else
			.Text = NomPropre(.text)
				cell.string = .text
			End If
		End With
	Next column
	theDialog.EndExecute
End Sub
'-----------------------------------------------------------------------
Function NomPropre(oTexte As String) As String
Dim oCalc
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   NomPropre = oCalc.callFunction("PROPER", array(oTexte))
End Function

Code : Tout sélectionner

[code]'-----------------------------------------------------------------------
'ECRIRE LE NOM DANS LA COLONNE D en MAJUSCULES
Function NomPropre(oTexte As String) As String
Dim oCalc
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   NomPropre = oCalc.callFunction("PROPER", array(oTexte))
End Function
'-------------------------------------------------------------------------------------------------------------------

Code : Tout sélectionner

Sub Main
   MiseEnMajuscule("D6")
End Sub

Function MiseEnMajuscule(NomDeCellule as String) As String
Dim MonDoc as Object, oCalc as Object, oTexte as String
   MonDoc = ThisComponent
   oTexte = MonDoc.Sheets(0).getCellRangeByName(NomDeCellule).String
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   MonDoc.Sheets(0).getCellRangeByName(NomDeCellule).String = oCalc.callFunction("UPPER", array(oTexte))
End Function

Code : Tout sélectionner

Sub Main
   MiseEnMajuscule("D6")
End Sub

De cette manière
[code]Sub Main
   MiseEnMajuscule("D6","C6","I6")
End Sub

Code : Tout sélectionner

Sub WriteToRowNumber(n As Integer)
	Dim control As Object, column As Integer, cell As Object, theDate As Long
''----------------------------------------------------------------------------------------------------------------	
	For column=firstColumn To lastColumn
		cell=theSheet.GetCellByPosition(column,n)
		control=theControls(column)
		'on distingue les types de contrôle
		With control
			If .SupportsService(listControl) Then
				cell.string=.SelectedItem
			ElseIf .SupportsService(dateControl) Then
				WriteDate control,cell
			Else
				Select Case column
					Case 2, 3, 8 ' Colonnes C, D, I
						cell.string = MiseEnMajuscule(.text)
					Case Else
						cell.string = NomPropre(.text)
				End Select
			End If
		End With
	Next column
	theDialog.EndExecute
End Sub