patel ha scritto:temo che sia necessario copiare i dati filtrati dal filtro standard su un'altra area perché con la soluzione sopra esposta l'array arr contiene tutti i dati, non solo quelli filtrati
Si può rimediare, non avevo pensato alll'array Arr, la macro l'ho modificata in quanto oltretutto funziona bene solo se i dati sono ordinati
Ora dovrebbe andare bene.
Codice: Seleziona tutto
Dim Sheet
Dim oDialogo1
Dim LB as object
Dim oTextBox
Dim Arr()
Sub Trasf_Bc
DialogLibraries.LoadLibrary("Standard")
oDialogo1 = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oDialogo1.Title = "Trasferimento Prodotti"
oDialogo1.getControl("TextField1").Enable = TRUE
oDialogo1.getControl("TextField2").Enable = FALSE
oDialogo1.getControl("TextField3").Enable = FALSE
oDialogo1.getControl("TextField4").Enable = FALSE
oDialogo1.getControl("TextField5").Enable = FALSE
oDialogo1.getControl("TextField6").Enable = FALSE
LB = oDialogo1.getControl("ListBox1")
oTextBox = oDialogo1.getControl("TextField1")
'Call Option_bc
oDialogo1.Execute()
oDialogo1.dispose()
End Sub
Sub Option_bc
Dim oCell
Dim oFilterDesc ' Filter descriptor.
Dim oFields(0) As New com.sun.star.sheet.TableFilterField2 '
Sheet = ThisComponent.Sheets(0)
LB.removeItems(0,LB.getItemCount())
Daric = UCase(oTextBox.Text)
c = Sheet.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow + 1
CellRange = Sheet.getCellRangeByName("A2:A" & LastRow)
oFilterDesc = CellRange.createFilterDescriptor(True)
With oFields(0)
.Field = 0
.Operator = com.sun.star.sheet.FilterOperator2.BEGINS_WITH
.StringValue = Daric
End With
oFilterDesc = CellRange.createFilterDescriptor(True)
With oFilterDesc
.ContainsHeader = False
.CopyOutputData = False
.FilterFields2 = oFields()
End With
CellRange.filter(oFilterDesc)
ranges = CellRange.queryVisibleCells()
ReDim Arr(0 To Ubound(ranges.RowDescriptions))
Dim a(0 To Ubound(ranges.RowDescriptions))
For Each oCell in ranges.Cells
Arr(x) = oCell.CellAddress.Row
a(x) = oCell.DataArray(0)
x = x +1
Next
If IsEmpty (a) = False Then
Dati = a
svc = createUnoService("com.sun.star.sheet.FunctionAccess")
Dati1 = svc.callFunction("TRANSPOSE", Array(a))
LB.getModel.StringItemList = Dati1(0)
End if
Call RemoveSheetFilter()
End sub
Sub List_Ordine
Dim Sheet
Dim MyCounter
Sheet = ThisComponent.Sheets(0)
MyCounter = Arr(LB.selectedItemPos)+1
oDialogo1.getControl("TextField2").text = Sheet.getCellRangeByName("A" & MyCounter).String
oDialogo1.getControl("TextField3").text = Sheet.getCellRangeByName("B" & MyCounter).String
oDialogo1.getControl("TextField4").text = Sheet.getCellRangeByName("C" & MyCounter).String
oDialogo1.getControl("TextField5").text = Sheet.getCellRangeByName("D" & MyCounter).String
oDialogo1.getControl("TextField6").text = Sheet.getCellRangeByName("E" & MyCounter).String
End Sub
Sub RemoveSheetFilter()
Dim oSheet ' Sheet to filter.
Dim oFilterDesc ' Filter descriptor.
oSheet = ThisComponent.getSheets().getByIndex(0)
oFilterDesc = oSheet.createFilterDescriptor(True)
oSheet.filter(oFilterDesc)
End Sub
Luka2017 ha scritto:Grazie per la soluzione.
Lo sto provando ma devo scrivere correttamente il nome senno' non appare ed è molto difficile ricordasi il nome preciso.
La macro funziona come le precedenti, cambia solo il metodo per popolare la listbox, la ricerca avviene sempre sui dati immessi quindi non capisco cosa vuoi dire.
Se scrivi "Bi" vengono filtrati tutti i nominativi che iniziano in questo modo quindi "Biondi" e "Bianchi"
