Option Explicit
Sub Main
' questo esempio esporta in excel il range di estrazioni selezionato
Dim xlApp ' oggetto excel
Dim idEstr,r,e,i,riga
Dim Inizio,Fine,nEstrTot
Dim nColor
Dim sCoord
Inizio = EstrazioneFin-10
Fine = EstrazioneFin
nEstrTot =(Fine + 1) - Inizio
If XlsApriFile(xlApp) Then ' istanzia excel
Call ScriviIntestazioneColonne ' scrive le intestazioni delle colonne
' ciclo per alimentare il foglio
riga = 1
For idEstr = Inizio To Fine ' cicla sulle estrazioni
riga = riga + 1 ' incrementa la riga dove andra a scrivere
i = 1
nColor = vbWhite ' preimposta il colore della colonna
' scrive la prima colonna con la data
Call XlsScriviC(riga,i,GetInfoEstrazione(idEstr))
' cicla sulle ruote dell'estrazione
For r = 1 To 12
If r <> 11 Then
' ad ogni cambio ruota inverte il colore della colonna
If nColor = vbCyan Then
nColor = vbWhite
Else
nColor = vbCyan
End If
' ciclo per scrivere i numeri dell'estrazione
For e = 1 To 5
i = i + 1
sCoord = XlsGetLetteraFromColonna(i) & riga ' calcola la coordnata della cella dove scrivere
Call XlsScrivi(sCoord,Estratto(idEstr,r,e),,,,,nColor)
Next
End If
Next
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
Call XlsAutoFit("A1:" & XlsGetLetteraFromColonna(56) & nEstrTot) ' esegue la funzione di adattamento delle colonne
Call XlsMostra ' mostra excel all'utente
End If
End Sub
Sub ScriviIntestazioneColonne
' scrive l'intestazione delle colonne nel foglio
Dim r,e,i
Dim nPrimaCol,nUltimaCol,sCoordC1,sCoordC2
sCoordC1 = "A1"
Call XlsScrivi(sCoordC1,"Data",,,True)
nPrimaCol = 1
For r = 1 To 12
If r <> 11 Then
nPrimaCol = nPrimaCol + 1
nUltimaCol =(nPrimaCol - 1) + 5
sCoordC1 = XlsGetLetteraFromColonna(nPrimaCol) & "1" ' calcola le coordinate delle cellle relative alla ruota
sCoordC2 = XlsGetLetteraFromColonna(nUltimaCol) & "1"
Call XlsScrivi(sCoordC1,NomeRuota(r),,,True,,,,xlsCenter)
Call XlsMerge(sCoordC1,sCoordC2,True) ' unisce le 5 celle contigue della ruota
Call XlsFormatoCella(sCoordC1 & ":" & sCoordC2,,,,,,xlsCenter) ' imposta l'allineamento
nPrimaCol = nUltimaCol
End If
Next
End Sub