Page 1 sur 1

[Résolu][Calc] éviter la redondance de saisie.

Publié : 06 avr. 2018 18:30
par boulauventre
Bonjour,

Je dois saisir une 40 aine de ligne de code par "article" sachant qu'il y a 300 artciles, je me demandait si vous n'auriez pas une astuce ou une formule à laquelle je n'aurait pensé, qui me permettrait de synthétiser la formule.

Je vous joint un fichier exemple pour vous rendre compte et voici également le code :

Code : Tout sélectionner

Txt = Inputbox ("tapez une lettre de l'alphabet grec ")

Dim monDocument As Object, maCellule As Object
Dim lesFeuilles as Object
Dim maFeuille as Object
Dim mess As String, cr As String

 monDocument = ThisComponent
    lesFeuilles = monDocument.Sheets
    maFeuille = lesFeuilles.getByName("StockA")
    maCellule = maFeuille.getCellRangeByName("B3")
    TxtAlpha = maCellule.value

If (Txt = "Alpha" ) then
			if TxtAlpha = 0 then 
    					Txt = InputBox ("tapez une lettre de l'alphabet grec ?") 
    						while Txt = "Alpha" 
    							Txt = InputBox ("ERREUR, lettre déjà tapée, tapez une autre lettre de l'alphabet grec ?")
    							If (Txt = "Bravo") then
    								Call StockSortantBravo
    								ElseIf (Txt = "Charlie") then
    									Call StockSortantCharlie
    									ElseIf (Txt = "Delta") then
    										Call StockSortantDelta
    										ElseIf (Txt = "Echo") then
    											Call StockSortantEcho
    											ElseIf (Txt = "Fox_trot") then
    												Call StockSortantFox_trot
    												ElseIf (Txt = "Golf") then
    													Call StockSortantGolf
    													ElseIf (Txt = "Hotel") then
    														Call StockSortantHotel
    														ElseIf (Txt = "India") then
    															Call StockSortantIndia
    															ElseIf (Txt = "Juliet") then
    																Call StockSortantJuliet
    																ElseIf (Txt = "Lima") then
    																	Call StockSortantLima
    																	ElseIf (Txt = "Mike") then
    																		Call StockSortantMike
    																		ElseIf (Txt = "November") then
    																			Call StockSortantNovember
    																		Else
    								EndIf
    							Wend ' Fin de la boucle
    				Else
    					Call StockSortantAlpha 
    				EndIf
    													
    														
    					
    				
    				
    				
    				
  
  	monDocument = ThisComponent
    lesFeuilles = monDocument.Sheets
    maFeuille = lesFeuilles.getByName("Perception")
    maCellule = maFeuille.getCellRangeByName("A5")
    maCellule.String = Txt   				
    

 	monDocument = ThisComponent
    lesFeuilles = monDocument.Sheets
    maFeuille = lesFeuilles.getByName("StockA")
    maCellule = maFeuille.getCellRangeByName("B4")
    TxtBravo = maCellule.value
    
If (Txt = "Bravo" ) then
	if TxtBravo = 0 then 
    	Txt = InputBox ("tapez une lettre de l'alphabet grec ?") 
    		while Txt = "Bravo" 
    							Txt = InputBox ("ERREUR, lettre déjà tapée, tapez une autre lettre de l'alphabet grec ?")
    							If (Txt = "Bravo") then
    							Call StockSortantBravo
    								ElseIf (Txt = "Charlie") then
    							Call StockSortantCharlie
    									ElseIf (Txt = "Delta") then
    							Call StockSortantDelta
    										ElseIf (Txt = "Echo") then
    							Call StockSortantEcho
    											ElseIf (Txt = "Fox_trot") then
    							Call StockSortantFox_trot
    												ElseIf (Txt = "Golf") then
    							Call StockSortantGolf
    													ElseIf (Txt = "Hotel") then
    							Call StockSortantHotel
    														ElseIf (Txt = "India") then
    							Call StockSortantIndia
    															ElseIf (Txt = "Juliet") then
    							Call StockSortantJuliet
    										ElseIf (Txt = "Lima") then
    							Call StockSortantLima
    										ElseIf (Txt = "Mike") then
    							Call StockSortantMike
    											ElseIf (Txt = "November") then
    							Call StockSortantNovember
    													
    													
    														Else
    														EndIf
    						Wend ' Fin de la boucle
    					Else
    					Call StockSortantBravo
    				EndIf
    				
Ici le code est pour 2 article seulement. je souhaiterais éviter de retaper tout à chaque fois pour chaque article (300 )

Merci d'avance de votre aide ;) :super: :super:

Re: [Calc] éviter la redondance de saisie.

Publié : 06 avr. 2018 22:21
par Piaf
Bonsoir
Un début de solution éventuelle.

Code : Tout sélectionner

Sub Main
Dim oDoc as Object, maPage as Object, maListe as Object
	oDoc = thisComponent
	maPage = oDoc.Sheets.getByName("Perception").DrawPage
	mesLettres = Array("Alpha","Bravo","Charlie","Delta","Echo","Foxtrot","Golf","Hotel","India","Juliett","Kilo","Lima","Mike","November","Oscar","Papa","Quebec","Romeo","Sierra","Tango","Uniform","Victor","Whisky","X-ray","Yankee","Zulu")
	maListe = maPage.Forms.getByName("Formulaire").getByName("maListe")
	maliste.StringItemList = mesLettres
End Sub

Sub ModifListe(oEv as Object)
Dim oDoc as Object, maFeuille as Object, maCellule as Object
	oDoc = thisComponent
	maFeuille = oDoc.Sheets.getByName("StockA")
	maCellule = maFeuille.getCellRangeByName("B" & oEv.Source.SelectedItemPos + 3)
	If maCellule.Value < 0 then
		MsgBox("Erreur, contactez l'administrateur")
	Else
		maCellule.Value = maCellule.value -1
	End If
End Sub
A+

Re: [Calc] éviter la redondance de saisie.

Publié : 03 mai 2018 23:20
par boulauventre
Merci de ta réponse !!

Désolé de ma réponse tardive j'avoue j'avais zappé étant donné que je ne n'étais pas servi de ça... :mrgreen: :mrgreen: :fou:

Pour info aux autre utilisateurs, voici ce que j'ai utilisé pour éviter la redondance de saisie.

Code : Tout sélectionner

Select case Txt
    		'------------------------------' ALPHA---------------------------
								        case   "216435", "216436" , "216437" , "216438" , "216439" , "216440" , "216441" , "216442" , "216443" , "216444" , "216445" , "216446" , "216447" , "216448" , "216449" , "216450" , "216451" , "216452" , "216453" , "216454" , "216455" , "216456" , "275121" , "216458" ,  "216459" , "216460" ,  "216461" , "216462" , "216463" , "216464" , "216465" , "216466" , "216467" , "216468" , "216469" , "216470" , "216471" , "216472" , "216473" , "216474" , "216475" , "216476" , "216477" , "216478" , "216479" , "216480" , "216481" , "216482" , "216483" , "216484" , "216485" , "216486" , "216487" , "216488" , "216489" , "216490" , "216491" , "216492" , "216493" , "216494" , "216495" , "216496" , "216497" ,  "216498" , "216499" , "216500" , "216501" , "216502" , "216503" , "216504" , "216505" , "216506" , "216507" , "216508" , "216509" , "216510" , "216511" , "216512" , "216513" , "216514" , "216515" , "216516" , "216517" , "216518" , "216519" , "216520" , "216521" , "216522" , "216523" , "216524" , "216525" , "216526" , "216527" , "216528" , "216529" , "216530" , "216531" , "216532" , "216533" , "216534" , "216535" , "216536" , "216537" , "216538" , "216539" , "216540" , "216541" , "216542" , "216543" , "216544" , "216545" , "216546" , "216547" , "216548" , "216549" , "216550" , "216551" , "216552" , "216553" , "216554"
    									Txt2 = "ALPHA"
    		'------------------------------' BETA---------------------------
    									case   "92100","92800","92803","91859","92809","91944","40299","91876","91844","91951","43303","43302","92797","43301","40300","92808","91935","40298","91927","43305","91938","91948","92846","92847","92848","92849","92850","92851","92852","92853","92854","92855","92856","92857","92858","92859","92860","92861","92862","92863","92864","92865","92866","92867","92868","92869","92870","92871","92872","92873","92874","92875","92876","92877","92878","92879","92880","92881","92882","92883","92884","92885","92886","92887","92888","92889","92890","92891","92892","92893","92894","92895","92896","92897","92898","92899","92900","92901","92902","92903","92904","92905","92906","92907","92908","92909","92910","92911","92912","92913","92914","92915","92916","92917","92918","92919","92920","92921","92922","92923","92924","92925","92926","92927","92928","92929","92930"
										Txt2 = "BETA"
End Select

Sachant que chaque numéro correspond à un numéro de série de l'article ALPHA ou BETA etc...

Ce m'a permis de ne copier qu'une fois pour toute tous les numéros et de pouvoir faire des copier coller.

Bonne journée :bravo: