[Risolto] Macro Campi_obbligatori e formattazione

[Arbellini]

Buongiorno a tutti,
vorrei rendere obbligatoria la compilazione di alcune celle in un tabella.
Nel file allegato:
Si tratta delle celle F6, F8, J8, F10, J10, F12.
Partendo dalla prima (F6), se vuota vorrei che sia evidenziata con colore, poi msgbox "Campo obbligatorio", altrimenti blocca macro,
se compilata controllare F8,
se F8 vuota evidenzia con colore, poi msgbox "campo obbligatorio", altrimenti blocca macro, così fino a F12.
Infine la macro si potrà eseguire SOLO SE la cella "C4" è uguale a "INSERIMENTO RECORD"

Codice: Seleziona tutto

sub copia
Doc = ThisComponent
Sheet = Doc.Sheets.getByName("data_entry") 
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
c = Sheet1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow + 2
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
End Sub

Allego file

[patel]

Non ho capito come vuoi fare il controllo, l'utente compila i dati e poi preme il tasto Inserisci per lanciare la macro Copia?
Inoltre vedo comandi abbastanza complessi come getDataArray e poi non sai controllare se una cella è vuota ?

[Arbellini]

Non ho capito come vuoi fare il controllo, l'utente compila i dati e poi preme il tasto Inserisci per lanciare la macro Copia?
Inoltre vedo comandi abbastanza complessi come getDataArray e poi non sai controllare se una cella è vuota ?

1) Si, l''utente compila i dati "obbligatori" e poi preme il tasto Inserisci per lanciare la macro, SE la cella "C4" è uguale a "INSERIMENTO RECORD" la macro Copia, altrimenti mi darà msgbox "..." (ma questo "msgbox" credo di poterlo fare io) ed uscire dalla macro.
2) Con le macro sono molto indietro, riesco solo a decifrarle, " i comandi abbastanza complessi come getDataArray" sono stati solo adattati alla mia esigenza, la macro non saprei farla da zero, quindi se riesco provo a cercarla prima nel forum.
3) Purtroppo no, non riesco, altrimenti non avrei chiesto aiuto.

[Arbellini]

Ho inserito la condizione finale

Codice: Seleziona tutto

If mode = "INSERIMENTO RECORD" then

avvia macro

Codice: Seleziona tutto

sub copia
Doc = ThisComponent 'legge il file
Sheet = Doc.Sheets.getByName("data_entry") 
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
mode = Sheet.getCellRangeByName("C4").string
c = Sheet1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow + 2
If mode = "INSERIMENTO RECORD" then
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
Else
msgbox "MODALITÀ ERRATA - INSERIMENTO NON EFFETTUATO"
End if
End Sub

Quello che mi resta da fare sarebbe la compilazione obbligatoria con formattazione.
Credo si debba fare con un ciclo for con step, ma non voglio dare suggerimenti
Se qualcuno vorrebbe darmi una mano ...

[patel]

prova questa (l'ho cambiata dopo la tua risposta)

Codice: Seleziona tutto

sub copia
Doc = ThisComponent 'legge il file
Sheet = Doc.Sheets.getByName("data_entry") 
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
mode = Sheet.getCellRangeByName("C4").string
Range0 = Sheet.getCellRangeByName("F6")
Range1 = Sheet.getCellRangeByName("F8")
Range2 = Sheet.getCellRangeByName("F12")
Range3 = Sheet.getCellRangeByName("J10")  
ranges = Array(range0,range1, range2, range3)    
for i = 0 to 3
  If ranges(i).string="" then
    Doc.CurrentController.Select(ranges(i))
    'ranges(i).CellBackColor = qbcolor(9)
    msgbox "CAMPO VUOTO"
    exit sub
  'else
   ' ranges(i).CellBackColor = RGB(240,255,240)
  end if
next i

If mode = "INSERIMENTO RECORD" then
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
Else
msgbox "MODALITÀ ERRATA - INSERIMENTO NON EFFETTUATO"
End if
End Sub

[Arbellini]

Al momento non mi è possibile provarla, potrò farlo nel pomeriggio.

Grazie

[Arbellini]

Funziona,

Codice: Seleziona tutto

Range0 = Sheet.getCellRangeByName("F6")
Range1 = Sheet.getCellRangeByName("F8")
Range2 = Sheet.getCellRangeByName("J8")
Range3 = Sheet.getCellRangeByName("F10")
Range4 = Sheet.getCellRangeByName("J10") 
Range5 = Sheet.getCellRangeByName("F12")

 
ranges = Array(range0,range1, range2, range3, range4, range5)    
for i = 0 to 5
  If ranges(i).string="" then
    Doc.CurrentController.Select(ranges(i))
    'ranges(i).CellBackColor = qbcolor(9)
    msgbox "CAMPO VUOTO"
    exit sub
  'else
   ' ranges(i).CellBackColor = RGB(240,255,240)
  end if
next i

facendo delle prove però, mi sono accorto che msgbox "CAMPO VUOTO" è troppo generico come messaggio, nel senso che mi piacerebbe che indicasse invece il nome del campo vuoto corrispondente, quindi il testo della cella a sn del campo. ho provato definendo nuovamente nuovi ranges dei nomi campi e aggiungendo ... ma no, non riesco.
Se possibile, altrimenti apro un nuovo post

[patel]

Forse non hai notato che in caso di errore viene selezionata la cella vuota, quindi basta scriverci, comunque si può fare anche quello che hai chiesto.

Codice: Seleziona tutto

sub copia
Doc = ThisComponent 'legge il file
Sheet = Doc.Sheets.getByName("data_entry") 
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
mode = Sheet.getCellRangeByName("C4").string
Range0 = Sheet.getCellRangeByName("F6")
Range1 = Sheet.getCellRangeByName("F8")
Range2 = Sheet.getCellRangeByName("F12")
Range3 = Sheet.getCellRangeByName("J10")  
ranges = Array(range0,range1, range2, range3)    
for i = 0 to 3
  If ranges(i).string="" then
    Doc.CurrentController.Select(ranges(i))
    'ranges(i).CellBackColor = qbcolor(9)
    msgbox "CAMPO VUOTO " &  rangeTextAddress(ranges(i))
    exit sub
  'else
   ' ranges(i).CellBackColor = RGB(240,255,240)
  end if
next i

If mode = "INSERIMENTO RECORD" then
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
Else
msgbox "MODALITÀ ERRATA - INSERIMENTO NON EFFETTUATO"
End if
End Sub

function rangeTextAddress(rng as object) as string
Dim Doc As Object, Sheet As Object, CellRange As Object
RngAddr=Rng.getRangeAddress
RngColumn=Rng.Columns
RngRow=Rng.Rows
CountColumn=RngColumn.getCount
CountRow=RngRow.getCount
FirstCol=RngColumn.getByIndex(0).getName
LastCol=RngColumn.getByIndex(CountColumn-1).getName
FirstRow=RngAddr.StartRow+1
LastRow=RngAddr.EndRow+1
NumCells=(CountColumn*CountRow) ' se serve
rangeTextAddress =FirstCol + FirstRow 
End Function

[Arbellini]

Si l'avevo notato, ma il messaggio generico distrae

[Arbellini]

Aggiungendo

Codice: Seleziona tutto

msgbox "CAMPO VUOTO " & rangeTextAddress(ranges(i))

Mi da errore di runtime BASIC
Sottoprocedura o funzione non definita.
Quello che intendevo si riferiva alla restituzione del nome del campo vuoto:
Ad es se F6 campo vuoto msgbox "CAMPO VUOTO & testo D6
= CAMPO VUOTO Cognome nome

[patel]

Aggiungendo

Codice: Seleziona tutto

msgbox "CAMPO VUOTO " & rangeTextAddress(ranges(i))

Non basta aggiungere quello, se guardi bene dopo la sub copia c'è una function.

[Arbellini]

Aggiungendo

Codice: Seleziona tutto

msgbox "CAMPO VUOTO " & rangeTextAddress(ranges(i))

Non basta aggiungere quello, se guardi bene dopo la sub copia c'è una function.

[Arbellini]

Grazie mille patel

[patel]

Aggiunto nome del campo

Codice: Seleziona tutto

sub copia
Doc = ThisComponent 'legge il file
Sheet = Doc.Sheets.getByName("data_entry") 
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
mode = Sheet.getCellRangeByName("C4").string
Range0 = Sheet.getCellRangeByName("F6")
Range1 = Sheet.getCellRangeByName("F8")
Range2 = Sheet.getCellRangeByName("F12")
Range3 = Sheet.getCellRangeByName("J10")  
ranges = Array(range0,range1, range2, range3)    
for i = 0 to 3
  If ranges(i).string="" then
    Doc.CurrentController.Select(ranges(i))
    'ranges(i).CellBackColor = qbcolor(9)
    msgbox "CAMPO VUOTO " &  rangeTextAddress(ranges(i),Sheet)
    exit sub
  'else
   ' ranges(i).CellBackColor = RGB(240,255,240)
  end if
next i

If mode = "INSERIMENTO RECORD" then
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
Else
msgbox "MODALITÀ ERRATA - INSERIMENTO NON EFFETTUATO"
End if
End Sub

Function rangeTextAddress(rng as object, SH  as object) as string
Dim Doc As Object, Sheet As Object, CellRange As Object
RngAddr=Rng.getRangeAddress
RngColumn=Rng.Columns
FirstCol=RngColumn.getByIndex(0).getName
FirstRow=RngAddr.StartRow+1
FCol=RngAddr.StartColumn-2
FRow=RngAddr.StartRow
rangeTextAddress =FirstCol + FirstRow + " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")"
End Function

[Arbellini]

Grazie

[Arbellini]

Riflessione

La macro formulata ha soddisfatto la mia richiesta, anzi niente da dire, MA, c'è un ma

La tabella data_entry alla fine del lavoro dovrà essere visualizzata senza griglie e riferimenti di righe e colonne,
per questo motivo preferirei che non comparissero nella msgbox i riferimenti di righe e colonne,
anche perché, essendo lo sfondo bianco senza riferimenti non avrebbe alcun senso sapere che il campo vuoto
appartiene ad es: "J8", mentre invece l'informazione corretta (penso io), dovrebbe essere riferita solo al Nome del campo (Cognome, data, etc.), seguita dalla formattazione.
Ora vista la complessità della function, alla quale non oso metterci mano, chiedevo quest'ultimo aiuto.
Non visualizzare i riferimenti di righe e colonne, ma solo del nome dei campi e conseguente formattazione (come quella attuale)
Naturalmente se fattibile.
Dopo di che penso di aver completato la prima parte del quadro
Per quello che verrà invece, spero di farmi sentire il meno possibile.

[patel]

modifica la riga
rangeTextAddress =FirstCol + FirstRow + " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")"
così
rangeTextAddress = sh.GetCellbyPosition(FCol,FRow).String

[Arbellini]

modifica la riga
rangeTextAddress =FirstCol + FirstRow + " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")"
così
rangeTextAddress = sh.GetCellbyPosition(FCol,FRow).String

Mannaggia lo avevo intuito

Grazie patel, ora è perfetto

Buona giornata

[patel]

Per imparare bisogna osare e non aver paura di sbagliare, si può sempre tornare indietro.

[Arbellini]

Si, lo so
ma avevo deciso di non mettere mano alla fuction,
Il problema principale che riscontro il Libreoffice è che non riesco a fare il debag (come nel VBA), per cui se ho idea di cosa si parla ci provo, diversamente non mi piace fare le cose alla cieca.

[Arbellini]

Si, lo so
ma avevo deciso di non mettere mano alla fuction,
Il problema principale che riscontro il Libreoffice è che non riesco a fare il debag (come nel VBA), per cui se ho idea di cosa si parla ci provo, diversamente non mi piace fare le cose alla cieca.

Anche se, a dire il vero ci avevo provato sostituendo con " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")", ma naturalmente non funzionava.

[Arbellini]

modifica la riga
rangeTextAddress =FirstCol + FirstRow + " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")"
così
rangeTextAddress = sh.GetCellbyPosition(FCol,FRow).String

Mannaggia lo avevo intuito

Grazie patel, ora è perfetto

Buona giornata

Per imparare bisogna osare e non aver paura di sbagliare, si può sempre tornare indietro.

Si, lo so
ma avevo deciso di non mettere mano alla fuction,
Il problema principale che riscontro il Libreoffice è che non riesco a fare il debag (come nel VBA), per cui se ho idea di cosa si parla ci provo, diversamente non mi piace fare le cose alla cieca.

Anche se, a dire il vero ci avevo provato sostituendo con " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")", ma naturalmente non funzionava.

Se non si conosce la teoria l'intuito a cosa serve?

[patel]

Il problema principale che riscontro il Libreoffice è che non riesco a fare il debag (come nel VBA)

Come in VBA puoi lanciare la macro passo passo con F8 e visualizzare le variabili col mouse.

[Arbellini]

Sono passato da poco a Libreoffice
Ho scaricato tute le guide che avete postato su questo forum, ma ancora devo leggerne una, infatti non conoscevo ancora i comandi dell'editor.
Per il momento do un'occhiata a questo https://wiki.openoffice.org/wiki/Docume ... d_Debugger
Grazie

[Arbellini]

Condivisione del risultato finale

Buona giornata

Codice: Seleziona tutto

REM  *****  BASIC  *****
sub copia
Doc = ThisComponent 'legge il file
Sheet = Doc.Sheets.getByName("data_entry") 
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
mode = Sheet.getCellRangeByName("C4").string

Range0 = Sheet.getCellRangeByName("F6")
Range1 = Sheet.getCellRangeByName("F8")
Range2 = Sheet.getCellRangeByName("J8")
Range3 = Sheet.getCellRangeByName("F10")
Range4 = Sheet.getCellRangeByName("J10") 
Range5 = Sheet.getCellRangeByName("F12")

 
ranges = Array(range0,range1, range2, range3, range4, range5)    
for i = 0 to 5
  If ranges(i).string="" then
    Doc.CurrentController.Select(ranges(i))
    'ranges(i).CellBackColor = qbcolor(9)
       msgbox "CAMPO VUOTO " &  rangeTextAddress(ranges(i),Sheet)
    exit sub
  'else
   ' ranges(i).CellBackColor = RGB(240,255,240)
  end if
next i
c = Sheet1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow + 2
If mode = "INSERIMENTO RECORD" then
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
Else
msgbox "MODALITÀ ERRATA - INSERIMENTO NON EFFETTUATO"
End if
End Sub

Function rangeTextAddress(rng as object, SH  as object) as string
Dim Doc As Object, Sheet As Object, CellRange As Object
RngAddr=Rng.getRangeAddress
RngColumn=Rng.Columns
FirstCol=RngColumn.getByIndex(0).getName
FirstRow=RngAddr.StartRow+1
FCol=RngAddr.StartColumn-2
FRow=RngAddr.StartRow
'rangeTextAddress =FirstCol + FirstRow + " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")"
rangeTextAddress = sh.GetCellbyPosition(FCol,FRow).String
'Sheet.getCellRangeByName("F6:F16").ClearContents(7) ' Cancella area celle di origine dei dati
'Sheet.getCellRangeByName("J8:J10").ClearContents(7)
'Sheet.getCellRangeByName("F22:F22").ClearContents(7)
'Sheet.getCellRangeByName("T35:AJ35").ClearContents(7)
End Function

[patel]

Una function deve essere utilizzabile anche in altri contesti, quindi meglio eliminare le ultime righe che fanno riferimento al foglio specifico.

[Arbellini]

Una function deve essere utilizzabile anche in altri contesti, quindi meglio eliminare le ultime righe che fanno riferimento al foglio specifico.

Scusa patel
quali righe, non l'ho capito

[patel]

Codice: Seleziona tutto

REM  *****  BASIC  *****
'Sheet.getCellRangeByName("F6:F16").ClearContents(7) ' Cancella area celle di origine dei dati
'Sheet.getCellRangeByName("J8:J10").ClearContents(7)
'Sheet.getCellRangeByName("F22:F22").ClearContents(7)
'Sheet.getCellRangeByName("T35:AJ35").ClearContents(7)

queste, anche se sono commentate, non ha senso tenerle in una function, devono stare nella sub.

[Arbellini]

Codice: Seleziona tutto

REM  *****  BASIC  *****
'Sheet.getCellRangeByName("F6:F16").ClearContents(7) ' Cancella area celle di origine dei dati
'Sheet.getCellRangeByName("J8:J10").ClearContents(7)
'Sheet.getCellRangeByName("F22:F22").ClearContents(7)
'Sheet.getCellRangeByName("T35:AJ35").ClearContents(7)

queste, anche se sono commentate, non ha senso tenerle in una function, devono stare nella sub.

Hai ragione

Codice: Seleziona tutto

REM ***** BASIC *****
sub copia
Doc = ThisComponent 'legge il file
Sheet = Doc.Sheets.getByName("data_entry")
Sheet1 = Doc.Sheets.getByName("Inserimento_dati")
mode = Sheet.getCellRangeByName("C4").string

Range0 = Sheet.getCellRangeByName("F6")
Range1 = Sheet.getCellRangeByName("F8")
Range2 = Sheet.getCellRangeByName("J8")
Range3 = Sheet.getCellRangeByName("F10")
Range4 = Sheet.getCellRangeByName("J10")
Range5 = Sheet.getCellRangeByName("F12")


ranges = Array(range0,range1, range2, range3, range4, range5)
for i = 0 to 5
If ranges(i).string="" then
Doc.CurrentController.Select(ranges(i))
'ranges(i).CellBackColor = qbcolor(9)
msgbox "CAMPO VUOTO " & rangeTextAddress(ranges(i),Sheet)
exit sub
'else
' ranges(i).CellBackColor = RGB(240,255,240)
end if
next i
c = Sheet1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow + 2
If mode = "INSERIMENTO RECORD" then
Sheet.getCellRangeByName("T35:AJ35").setDataArray(Sheet.getCellRangeByName("T33:AJ33").getDataArray)
Range = Sheet.getCellRangeByName("T35:AJ35").getRangeAddress()
CellAddress = Sheet1.getCellRangeByName("C" & Lastrow).CellAddress
Sheet.copyRange(CellAddress, Range)
'Sheet.getCellRangeByName("F6:F16").ClearContents(7) ' Cancella area celle di origine dei dati
'Sheet.getCellRangeByName("J8:J10").ClearContents(7)
'Sheet.getCellRangeByName("F22:F22").ClearContents(7)
'Sheet.getCellRangeByName("T35:AJ35").ClearContents(7)
Else
msgbox "MODALITÀ ERRATA - INSERIMENTO NON EFFETTUATO"
End if
End Sub

Function rangeTextAddress(rng as object, SH as object) as string
Dim Doc As Object, Sheet As Object, CellRange As Object
RngAddr=Rng.getRangeAddress
RngColumn=Rng.Columns
FirstCol=RngColumn.getByIndex(0).getName
FirstRow=RngAddr.StartRow+1
FCol=RngAddr.StartColumn-2
FRow=RngAddr.StartRow
'rangeTextAddress =FirstCol + FirstRow + " (" + sh.GetCellbyPosition(FCol,FRow).String + + ")"
rangeTextAddress = sh.GetCellbyPosition(FCol,FRow).String
End Function

[Arbellini]

Mi sono accorto di un piccolo errore nella tabella, ora corretto.
Credo di essere riuscito ad aprire la prima scatola,
grazie all'aiuto di patel.
Considerate questo file come definitivo.

Buona giornata