[Risolto]macro filtro intervallo tra due date + cliente

[nikolas1194]

Buongiorno a tutti,
prima di aprire il nuovo argomento ho cercato nel forum delle soluzioni (sia nella sezione "Calc" che in questa), ma senza trovare qualcosa che mi aiutasse. Ho cominciato da pochissimo a lavorare con OpenOffice e sto creando un file Calc per la gestione delle scadenze dei prodotti ordinati su commessa. Volevo un aiuto per costruire una macro nella prima cartella ("CERCA") che copi in quest'ultima tutte le voci degli ordini dalla seconda cartella ("SCAD"), che corrispondono ad un cliente e che abbiano come consegna una data compresa tra due inserite dall'utente e calcoli il totale nella cella sotto "TOT.MESE".
Per rendere la cosa ancora più utile vorrei non mettere come obbligatorio l'inserimento del cliente per la ricerca (magari inserendo nell'elenco TUTTI) è possibile?
Allego file con dati di prova e prima cartella che mostra il risultato che vorrei ottenere.

Ringrazio in anticipo per l'aiuto e mi scuso nel caso in cui ci siano argomenti aperti analoghi a questo.
Nikolas

[Gaetanopr]

Il tutto funziona tramite il filtro speciale da macro che viene azionata al variare della cella CLIENTE, quindi è indispensabile variare prima le date e alla fine il Cliente.
Se si vogliono riportare tutti i clienti ti basta lasciare la cella vuota, il range A1:C2 del foglio Cerca và lasciato vuoto in quanto serve come area dei criteri per il filtro.

Saluti

[nikolas1194]

Il tutto funziona tramite il filtro speciale da macro che viene azionata al variare della cella CLIENTE, quindi è indispensabile variare prima le date e alla fine il Cliente.
Se si vogliono riportare tutti i clienti ti basta lasciare la cella vuota, il range A1:C2 del foglio Cerca và lasciato vuoto in quanto serve come area dei criteri per il filtro.

Saluti

Nel file che mi hai allegato non risulta nessuna macro. Itanto ti chiedo una delucidazione: visto che la macro si dovrebbe attivare appena vado a riempire il campo cliente, conviene quindi invertire celle mettendo in E2-F2 Data inizio, E3-F3 data fine e in E4-F5 il Cliente per evitare che venga messo per primo? E funziona anche se il cliente viene inserito con selezione da menù a tendina? E per togliere il filtro come dovrei fare?

grazie per i chiarimenti

[Gaetanopr]

Nel file che mi hai allegato non risulta nessuna macro

Ne sei sicuro ? ho appena scaricato il file e tutto funziona bene, questa è la macro presente nel modulo Foglio1

Codice: Seleziona tutto

Sub Scadenziario(Target)

 If NOT Target.supportsService("com.sun.star.sheet.SheetCell") then exit sub
 If Target.AbsoluteName <> "$CERCA.$F$2" then exit sub

Dim ShSCAD As Object, ShCerca As Object 
Dim LastCol As Long, LastRow As Long
Dim Args(3) as New com.sun.star.beans.PropertyValue
Dim i As Long     'A sheet from the Calc document.
Dim oRanges As Object   'The NamedRanges property.
Dim oCritRange As Object'Range that contains the filter criteria.
Dim oDataRange As Object'Range that contains the data to filter.
Dim oFiltDesc  As Object'Filter descriptor.
Dim x As New com.sun.star.table.CellAddress 
Dim oCursor As Object

Doc = ThisComponent
ShCerca = Doc.sheets.getbyname("CERCA")
ShSCAD = Doc.sheets.getbyname("SCAD")
DataIn = ShCerca.GetCellRangeByname("F3").Value
DataFin = ShCerca.GetCellRangeByname("F4").Value
CDataIn = DateSerial( Year(DataIn), Month(DataIn), Day(DataIn))
CDataFin = DateSerial( Year(DataFin), Month(DataFin), Day(DataFin))
Cliente = ShCerca.getCellRangeByName("F2").string

If DataFin = 0 Or DataIn = 0 Then MsgBox "Date non valorizzate" : Exit Sub
If DataFin < DataIn Then MsgBox "Hai indicato una data finale inferiore a quella iniziale" : Exit Sub

    oCursor = ShSCAD.createcursor
    oCursor.gotoendofusedarea(false)
    LastRow = oCursor.rangeaddress.Endrow
    LastCol = oCursor.rangeaddress.Endcolumn
    oDataRange = ShSCAD.getCellRangeByPosition(1, 1, LastCol, LastRow)
  
      
       Dim Curs As Object, LR As Long, LC As Long
       Curs = ShCerca.createcursor
       Curs.gotoendofusedarea(false)
       LR = oCursor.rangeaddress.Endrow
       LC = oCursor.rangeaddress.Endcolumn
       ShCerca.GetCellRangeByPosition(1, 5, LC, LR).ClearContents(1023) 
       ShCerca.getCellRangeByName("A1").String = "CLIENTE"
       ShCerca.getCellRangeByName("B1").String = "CONS"
       ShCerca.getCellRangeByName("C1").String = "CONS"
       ShCerca.getCellRangeByName("A2").string = Cliente 
       ShCerca.getCellRangeByName("B2").string =  ">="& CDataIn & ""
       ShCerca.getCellRangeByName("C2").string = "<="& CDataFin & ""
              
       oCritRange = ShCerca.getCellRangeByName("A1:C2")
 
       oFiltDesc = oCritRange.createFilterDescriptorByObject(oDataRange)
       oFiltDesc.ContainsHeader = True
       oFiltDesc.SkipDuplicates = False 'True
       oFiltDesc.CopyOutputData = True
       For i = 0 To Doc.Sheets.Count - 1
         If Doc.Sheets(i).Name = "CERCA" Then
           x.sheet = i
           exit for
         End if
       Next i
       x.column = 1
       x.row = 6
  
       oFiltDesc.OutputPosition = x
       oDataRange.filter(oFiltDesc)
       oCritRange.ClearContents(1+2+4) 
  End Sub     

La convenienza la decide chi compila il modulo, per quanto mi riguarda io non avrei problemi anche con l'attuale impostazione, per eliminare il filtro basta non indicare il cliente e mettere la data iniziale e finale minima e massima, puoi usare il menù a tendina.

PS: Se ti viene meglio puoi azionare la macro con un pulsante dopo aver compilato i vari campi.

[patel]

Il file originale deriva da un xlsm e stranamente con Libre la macro non si vede, con Openoffice nessun problema

[nikolas1194]

Nel file che mi hai allegato non risulta nessuna macro

Ne sei sicuro ? ho appena scaricato il file e tutto funziona bene, questa è la macro presente nel modulo Foglio1

Codice: Seleziona tutto

Sub Scadenziario(Target)

 If NOT Target.supportsService("com.sun.star.sheet.SheetCell") then exit sub
 If Target.AbsoluteName <> "$CERCA.$F$2" then exit sub

Dim ShSCAD As Object, ShCerca As Object 
Dim LastCol As Long, LastRow As Long
Dim Args(3) as New com.sun.star.beans.PropertyValue
Dim i As Long     'A sheet from the Calc document.
Dim oRanges As Object   'The NamedRanges property.
Dim oCritRange As Object'Range that contains the filter criteria.
Dim oDataRange As Object'Range that contains the data to filter.
Dim oFiltDesc  As Object'Filter descriptor.
Dim x As New com.sun.star.table.CellAddress 
Dim oCursor As Object

Doc = ThisComponent
ShCerca = Doc.sheets.getbyname("CERCA")
ShSCAD = Doc.sheets.getbyname("SCAD")
DataIn = ShCerca.GetCellRangeByname("F3").Value
DataFin = ShCerca.GetCellRangeByname("F4").Value
CDataIn = DateSerial( Year(DataIn), Month(DataIn), Day(DataIn))
CDataFin = DateSerial( Year(DataFin), Month(DataFin), Day(DataFin))
Cliente = ShCerca.getCellRangeByName("F2").string

If DataFin = 0 Or DataIn = 0 Then MsgBox "Date non valorizzate" : Exit Sub
If DataFin < DataIn Then MsgBox "Hai indicato una data finale inferiore a quella iniziale" : Exit Sub

    oCursor = ShSCAD.createcursor
    oCursor.gotoendofusedarea(false)
    LastRow = oCursor.rangeaddress.Endrow
    LastCol = oCursor.rangeaddress.Endcolumn
    oDataRange = ShSCAD.getCellRangeByPosition(1, 1, LastCol, LastRow)
  
      
       Dim Curs As Object, LR As Long, LC As Long
       Curs = ShCerca.createcursor
       Curs.gotoendofusedarea(false)
       LR = oCursor.rangeaddress.Endrow
       LC = oCursor.rangeaddress.Endcolumn
       ShCerca.GetCellRangeByPosition(1, 5, LC, LR).ClearContents(1023) 
       ShCerca.getCellRangeByName("A1").String = "CLIENTE"
       ShCerca.getCellRangeByName("B1").String = "CONS"
       ShCerca.getCellRangeByName("C1").String = "CONS"
       ShCerca.getCellRangeByName("A2").string = Cliente 
       ShCerca.getCellRangeByName("B2").string =  ">="& CDataIn & ""
       ShCerca.getCellRangeByName("C2").string = "<="& CDataFin & ""
              
       oCritRange = ShCerca.getCellRangeByName("A1:C2")
 
       oFiltDesc = oCritRange.createFilterDescriptorByObject(oDataRange)
       oFiltDesc.ContainsHeader = True
       oFiltDesc.SkipDuplicates = False 'True
       oFiltDesc.CopyOutputData = True
       For i = 0 To Doc.Sheets.Count - 1
         If Doc.Sheets(i).Name = "CERCA" Then
           x.sheet = i
           exit for
         End if
       Next i
       x.column = 1
       x.row = 6
  
       oFiltDesc.OutputPosition = x
       oDataRange.filter(oFiltDesc)
       oCritRange.ClearContents(1+2+4) 
  End Sub     

La convenienza la decide chi compila il modulo, per quanto mi riguarda io non avrei problemi anche con l'attuale impostazione, per eliminare il filtro basta non indicare il cliente e mettere la data iniziale e finale minima e massima, puoi usare il menù a tendina.

PS: Se ti viene meglio puoi azionare la macro con un pulsante dopo aver compilato i vari campi.

La macro alla fine l'ho trovata (avevo guardato per sbaglio nel modulo di un altro file di openoffice che avevo aperto il quel momento ). Però non parte. Ho provato anche ad aggiungere un pulsante a cui ho assegnato la macro, ma non succedere nulla.

Ps.alla fine ho invertito l'ordine di inserimento mettendo: data inizio, data fine e cliente modificando anche la macro nel dodice in cui va a prenere i valori dalle celle.

Non capisco dove sto sbagliando...

Riallego file con modifiche

[Gaetanopr]

Se usi il pulsante alcune righe non servono, il parametro target serve ad intercettare la cella che scatena l'evento "contenuto modificato" del foglio, quindi le prime 3 righe sono superflue ma soprattutto causano un errore, devi pure eliminare l'associazione della macro all'evento "contenuto modificato"
Hai provato il file che ho allegato io? o copiato la macro su altro file, perchè funziona tutto bene anche patel conferma.

[nikolas1194]

Se usi il pulsante alcune righe non servono, il parametro target serve ad intercettare la cella che scatena l'evento "contenuto modificato" del foglio, quindi le prime 3 righe sono superflue ma soprattutto causano un errore, devi pure eliminare l'associazione della macro all'evento "contenuto modificato"
Hai provato il file che ho allegato io? o copiato la macro su altro file, perchè funziona tutto bene anche patel conferma.

EURECA!!! Ho abbassato il livello di sicurezza delle macro a medio ed ora funziona premendo il pulsante

Però ho una piccola richiesta sempre legata a questa macro: è possibile fare in modo che copi anche i commenti di? tipo quelli legati alle due voci nelle righe 6 e 7?

Riallego il file con la macro che si attiva premendo il pulsante

grazie per l'aiuto

[Gaetanopr]

Però ho una piccola richiesta sempre legata a questa macro: è possibile fare in modo che copi anche i commenti di? tipo quelli legati alle due voci nelle righe 6 e 7?

Non è piccola come richiesta, ad accorgersene prima(sarà una dimenticanza degli sviluppatori) si poteva procedere diversamente anche se credo che l'uso del filtro sia il sistema più veloce per questo tipo di richieste, quindi ho preferito modificare la macro.

[nikolas1194]

Però ho una piccola richiesta sempre legata a questa macro: è possibile fare in modo che copi anche i commenti di? tipo quelli legati alle due voci nelle righe 6 e 7?

Non è piccola come richiesta, ad accorgersene prima(sarà una dimenticanza degli sviluppatori) si poteva procedere diversamente anche se credo che l'uso del filtro sia il sistema più veloce per questo tipo di richieste, quindi ho preferito modificare la macro.

Funziona perfettamente.

Grazie mille per l'aiuto