[Calc] Contenu de liste liée à une autre

[Dude]

Comme c'est une

Voici un classeur qui comprend deux listes :

apercu.PNG

Principe :
La sélection dans la liste Marque entraîne une mise à jour de la liste Modèle. La sélection dans la liste Modèle copie le résultat Marque / Modèle dans une autre feuille.

Deux macros suffisent :

Code : Tout sélectionner

Sub ChargeModele(Evenement)
	Dim initList(0) as new com.sun.star.beans.NamedValue
	NomPlage = Evenement.Source.SelectedItem
	If NomPlage = "" Then NomPlage = "Vide"
	laPlage = thisComponent.NamedRanges.getByName("M_" & NomPlage).getReferredCells()
	initList(0).Name = "CellRange" 
	initList(0).Value = laPlage.RangeAddress
	maListe = Evenement.Source.Model.Parent.getByName("lModele")
	maListe.setListEntrySource(thisComponent.createInstanceWithArguments("com.sun.star.table.CellRangeListSource", initList()))
End Sub


sub BasculeForm
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 = "SwitchControlDesignMode"
args1(0).Value = false

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


end sub

[Dude]

Dans la même veine, des zones de liste liées dans un dialogue :

no_problemo.gif

Les routines nécessaires :

Code : Tout sélectionner

REM  *****  BASIC  *****
Global oDoc as object, oDlg as object

Sub Main
	oDoc = ThisComponent
	oDoc.DialogLibraries.loadLibrary("Standard")
	oBib = oDoc.DialogLibraries.GetByName("Standard")
	zDlg = oBib.GetByName("Dialog1") 
	oDlg = CreateUnoDialog(zDlg)
	aMarque = RecupMarque("A1:C1")
	RemplirListe("lMarque", aMarque)

	cOK = com.sun.star.ui.dialogs.ExecutableDialogResults.OK
	if oDlg.Execute = cOK then
		sRet = oDlg.getControl("lMarque").SelectedItem & " " & _
				 oDlg.getControl("lModele").SelectedItem
		oDlg.dispose
		oDoc.CurrentSelection.String = sRet
	else
		exit Sub
	end if
	
End Sub

Sub RemplirListe(sListe, sTab)
	oListe = oDlg.getControl(sListe)
	oListe.Model.stringItemList = sTab
	oliste.selectItemPos(0, true)
End Sub

Function RecupMarque(sZone)
	oFeuil = oDoc.Sheets(1) ' La 1ere feuille est indexée à 0
	oPlage = oFeuil.getCellRangeByName(sZone)
	aTab = oPlage.DataArray
	nMax = UBound(aTab(0))
	Dim sTab(nMax)
	For i = 0 to nMax
		sTab(i) = aTab(0)(i)
	Next i
	RecupMarque = sTab 
End function

Function RecupModele(sMarque)
	oPlages = oDoc.NamedRanges
	oPlage = oPlages.getByName("Z_" & sMarque).getReferredCells()
	aTab = oPlage.DataArray
	nMax = UBound(aTab)
	Dim sTab(nMax)
	For i = 0 to nMax
		if sTab(i)(0) = "" then exit for
		sTab(i) = aTab(i)(0)
	Next i
	RecupModele = sTab
End Function

Sub ChangeListe(oEvt)
	oSrc = oEvt.Source
	sMarque = oSrc.SelectedItem
	aModele = RecupModele(sMarque)		
	RemplirListe("lModele", aModele)
End Sub