Apache OpenOffice: forum della comunità

Codice: Seleziona tutto

Sub Email
Dim collezione As New Collection
   Sh = ThisComponent.Sheets.getByName("Foglio1") 
   c = Sh.createCursor
   c.gotoEndOfUsedArea(false)
   LastRow = c.RangeAddress.EndRow
   Lista() = Sh.getCellRangeByName("Q2:Q" & LastRow + 1).GetDataArray
   
   For i = 0 To Ubound(Lista)
      codice = Split(Lista(i)(0), ", ")
           
         On Error Resume Next
         For n = 0 To Ubound(codice)
             Verifica:
             cod1 = Instr(codice(n),"@") : cod2 = Instr(codice(n),".")
             If cod1 > 0 And cod2 > 0 Then 
                collezione.Add(codice(n), CStr(Codice(n)))
             Else
                codice(n) = InputBox  ("Verificare esattezza indirizzo email: ","Verifica",codice(n) )
                Goto Verifica
             End if   
         Next n
  
   Next i 
   On Error Goto 0


oDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, Array() )
   Sh2 = oDoc.Sheets.getByName("Foglio1") 
   Sh2.getCellByPosition(0, x).String = "e-mail"
   For x = 1 To collezione.Count
      Sh2.getCellByPosition(0, x).String = collezione(x)
      Dati = Split(collezione(x), "@")
      Dati2 = Split(collezione(x), ".")
      Sh2.getCellByPosition(1, x).String = Dati(0)
      Sh2.getCellByPosition(2, x).String = Dati(1)
      Sh2.getCellByPosition(3, x).String = Dati2(Ubound(Dati2))
   Next x

c = Sh2.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow

Dim OrdineCampi(2) As New com.sun.star.table.TableSortField
Dim mDescriptorOrden()
Range = Sh2.getCellRangeByPosition(0, 1, 3, LastRow)
mDescriptorOrden = Range.createSortDescriptor()
   
   OrdineCampi(0).Field = 2
   OrdineCampi(0).IsAscending = True
   OrdineCampi(0).IsCaseSensitive = False
   OrdineCampi(0).FieldType = com.sun.star.table.TableSortFieldType.AUTOMATIC
   OrdineCampi(1).Field = 3
   OrdineCampi(1).IsAscending = True
   OrdineCampi(1).IsCaseSensitive = False
   OrdineCampi(1).FieldType = com.sun.star.table.TableSortFieldType.AUTOMATIC
   OrdineCampi(2).Field = 1
   OrdineCampi(2).IsAscending = True
   OrdineCampi(2).IsCaseSensitive = False
   OrdineCampi(2).FieldType = com.sun.star.table.TableSortFieldType.AUTOMATIC
   
   mDescriptorOrden(1).Name = "ContainsHeader"
   mDescriptorOrden(1).Value = False
   mDescriptorOrden(3).Name = "SortFields"
   mDescriptorOrden(3).Value = OrdineCampi

   Range.sort( mDescriptorOrden )  
Sh2.getCellRangeByPosition(1, 1, 3, LastRow).ClearContents(1023)
Dim prop()
adressDoc = convertToURL("p:\email.xls")   '<<<<<< da modificare
oDoc.storeAsURL(adressDoc, prop() )
oDoc.close(true)    
End Sub

Codice: Seleziona tutto

ThisComponent.addActionLock
ThisComponent.LockControllers = Application.ScreenUpdating = false
..... cicli ....
ThisComponent.UnlockControllers = Application.ScreenUpdating = True 

Codice: Seleziona tutto

Sub Email2
ThisComponent.addActionLock
ThisComponent.LockControllers = Application.ScreenUpdating = false

Codice: Seleziona tutto

errore di runtime BASIC 
variabile dell'oggetto non impostata

Codice: Seleziona tutto

myDoc = ThisComponent
myDoc.lockControllers()
myDoc.addActionLock()
' --- modify your cells here ---
myDoc.removeActionLock()
myDoc.unlockControllers()

Codice: Seleziona tutto

Sub Email5
	Dim FileSoggetti as object
	dim Sh as object
	FileSoggetti = ThisComponent
	Sh = FileSoggetti.Sheets.getByName("Foglio1")
rem determinazione ultima riga del foglio in FileSoggetti
	dim c as object
	dim UltimaRigaFileSoggetti as long
	dim UltimaColonnaFileSoggetti as long
	c = Sh.createCursor
	c.gotoEndOfUsedArea(false)
	UltimaRigaFileSoggetti = c.RangeAddress.EndRow
	UltimaColonnaFileSoggetti = c.RangeAddress.EndColumn
rem cerco l'indice delle colonne "cod.", "denominazione","email"
	dim RangeIntestazioneColonne as object
	dim oDescriptor
	dim oFound
	dim ColonnaCod as long
	dim ColonnaDenominazione as long
	dim ColonnaEmail as long
	RangeIntestazioneColonne = Sh.getCellRangeByPosition(0,0,UltimaColonnaFileSoggetti,0)
	oDescriptor = RangeIntestazioneColonne.createSearchDescriptor()
	'cod.
	With oDescriptor						'proprietà di ricerca
		.SearchString = "cod."				'testo da cercare
		.SearchWords = True					'vero che sono parole
		.SearchType = 1						'inteso come contenuto cella
		.SearchCaseSensitive = False		'ignora maiuscolo/minuscolo
	End With
	oFound = RangeIntestazioneColonne.findFirst(oDescriptor)
	ColonnaCod = oFound.getCellAddress.Column	'numero indice della colonna 
	'denominazione
	With oDescriptor
		.SearchString = "denominazione"
		.SearchWords = True
		.SearchType = 1
		.SearchCaseSensitive = False
	End With
	oFound = RangeIntestazioneColonne.findFirst(oDescriptor)
	ColonnaDenominazione = oFound.getCellAddress.Column
	'e-mail
	With oDescriptor
		.SearchString = "e-mail"
		.SearchWords = True
		.SearchType = 1
		.SearchCaseSensitive = False
	End With
	oFound = RangeIntestazioneColonne.findFirst(oDescriptor)
	ColonnaEmail = oFound.getCellAddress.Column
rem inizio istruzioni per raccolta in "collezione" delle stringe da scrivere nel FileEmail
	dim RangeDati as object
	dim ArrDati as object
	dim NumeroRighe as long
	dim IndiceRiga as long
	dim NumeroCicli as long
	dim Dato as string
	dim ArrEmail()
	dim n as integer
	dim cod1 as integer
	dim cod2 as integer
	dim Testo1 as string
	dim Testo2 as string
	dim TestoComposto as string
	dim ArrTesto() as variant
	dim TestoPerScrittura as string
	Dim Collezione As New Collection
	RangeDati = Sh.getCellRangeByPosition(0,1,UltimaColonnaFileSoggetti,UltimaRigaFileSoggetti)	'insieme delle celle contenti i dati escluso intestazione colonne
	ArrDati() = RangeDati.getDataArray()	'insieme bi-dimensionale dei dati contenuti nelle celle
	NumeroRighe = RangeDati.Rows.Count		'numero di righe di RangeDati
	IndiceRiga = 0		'indice della prima riga dell'insieme bi-dimensionale di dati
	NumeroCicli = NumeroRighe -1	'numero di cicli da effettuare
	Do While IndiceRiga <= NumeroCicli	'ciclo condizionato: se condizione "vera" esegue il ciclo
		Dato = ArrDati(IndiceRiga)(ColonnaEmail)	'valore (stringa)
		On Error Resume next	'gestione errore nel caso Dato sia vuoto
		ArrEmail() = Split(Dato, ", ")	'suddivide il valore in una matrice in base al separatore ", "
		For n = 0 To Ubound(ArrEmail())	'ciclo all'interno all'interno della matrice arrEmail
			Verifica:
			cod1 = Instr(arrEmail(n),"@") : cod2 = Instr(arrEmail(n),".")
			If cod1 > 0 And cod2 > 0 Then	'se cod1 e cod2 sono maggiori di 0 allora lindirizzo mail contiene @ ed almeno un punto
				Testo1 = ArrDati(IndiceRiga)(ColonnaCod)	'testo cella colonna A
				Testo2 = ArrDati(IndiceRiga)(ColonnaDenominazione)	'testo cella colonna D
				TestoComposto = Testo1 & " " & Testo2 	'somma dei due testi
				ArrTesto() = Array(TestoComposto,arrEmail(n))	'insieme dei testi
				TestoPerScrittura = Join(ArrTesto(),"|")	'concatena l'insieme dei due testi separati da "|"
				Collezione.Add(TestoPerScrittura, CStr(TestoPerScrittura))	'inserisce il testo nella collezione
			Else
				arrEmail(n) = InputBox ("Verificare esattezza indirizzo email: ","Verifica",arrEmail(n) )
				Goto Verifica
			end if
		next n
			On Error GoTo 0
		IndiceRiga = IndiceRiga +1	'aumento di una unità per passare all'indice successivo
	Loop
rem creazione ed apertura del FileEmail
	dim FileEmail as object
	dim Sh2 as object
	dim RigaInizioScritturaSh2 as long
	dim pippo as string
	dim x as long
	dim Stringa
	dim i as integer
	FileEmail = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_default", 0, Array() )
	Sh2 = FileEmail.Sheets.getByName("Foglio1")
	Sh2.getCellRangeByName("A1").string = "denominazione"	'testo cella A1
	Sh2.getCellRangeByName("A1").CharWeight= 150	'grassetto
	Sh2.getCellRangeByName("B1").string = "e-mail"	'testo cella B1
	Sh2.getCellRangeByName("B1").CharWeight= 150	'grassetto
rem inizio scrittura dei dati contenuti in "collezione"
	RigaInizioScritturaSh2 = 2	'riga di partenza per scrittura su FoglioEmail
	For x = 1 To Collezione.Count	'tanti cicli quanti sono gli elementi che costituiscono la collezione
		Stringa = split(Collezione(x),"|")
		For i = 0 to UBound(Stringa)	'sono sempre previsti due cicli
			if i = 0 then
				Sh2.getCellRangeByName("A" & RigaInizioScritturaSh2).string = Stringa(i)	'scrive denominazione
			else
				Sh2.getcellRangeByName("B" & RigaInizioScritturaSh2).string = Stringa(i)	'scrive e-mail
			end if
		next i
		RigaInizioScritturaSh2 = RigaInizioScritturaSh2 +1	'aumento di una unità per passare alla riga successiva
	Next x
	Sh2.Columns().OptimalWidth = True	'larghezza ottimale di tutte le colonne
rem ordinamento documento email
	dim UltimaRigaFileEmail as long
	dim Range as object
	Dim OrdineCampi(0) As New com.sun.star.util.SortField
	Dim mDescriptorOrden(0) As New com.sun.star.beans.PropertyValue
	c = Sh2.createCursor
	c.gotoEndOfUsedArea(false)
	UltimaRigaFileEmail = c.RangeAddress.EndRow
	Range = Sh2.getCellRangeByPosition(0, 1, 3, UltimaRigaFileEmail)
	OrdineCampi(0).Field = 0	'riferimento alla colonna A
	OrdineCampi(0).SortAscending = True	'ordinamento ascendete
	mDescriptorOrden(0).Name = "SortFields"
	mDescriptorOrden(0).Value = OrdineCampi()
	Range.sort(mDescriptorOrden()) 
rem salvataggio del FileEmail con estensione xls 
	dim mFileType(0) as new com.sun.star.beans.PropertyValue
	dim adressDoc as string
	mFileType(0).Name = "FilterName"
	mFileType(0).Value="MS Excel 97"
	adressDoc = ConvertToURL("d:\tem\NomeFile.xls")   '<<<<<< da modificare
	FileEmail.StoreAsURL( adressDoc, mFileType())
	FileEmail.close(true)
End Sub