L
LuigiB
Guest
ciao Joe .. posto a beneficio di chi usa quel file lo script da lanciare in spaziometria
per fare l'aggiornamento
per fare l'aggiornamento
Codice:
Option Explicit
Sub Main
Dim xlApp ' oggetto excel
Dim xlBook ' insieme di cartelle di lavoro
Dim xlSheet ' foglio di lavoro
Dim sFileXls
Dim sLastData
Dim idEstr ,k , r ,nLastRiga , nAggiornate
Dim aNum
sFileXls = ScegliFile("",".xls")
If FileEsistente(sFileXls) Then
If OpenExcelFile(xlApp,xlBook,xlSheet,sFileXls)Then
sLastData = GetUltimaDataIns(xlSheet , nLastRiga)
If IsDate(sLastData) Then
idEstr = DataEstrToIdEstr( Day(sLastData ), Month(sLastData) ,Year(sLastData))
If idEstr <> 0 Then
For k = idEstr+1 To EstrazioniArchivio
nLastRiga = nLastRiga +1
Messaggio DataEstrazione(k)
DoEventsEx
If ScriptInterrotto Then Exit For
xlSheet.cells(nLastRiga , 1) = IndiceAnnuale(k) & "-" & DataEstrazione( k ,,,"/")
For r = 1 To 11
If r = 11 Then
Call GetArrayNumeriRuota (k ,12,aNum)
Else
Call GetArrayNumeriRuota (k ,r,aNum)
End If
xlSheet.cells(nLastRiga , r + 1) = FormattaNumeri (aNum)
Next
nAggiornate = nAggiornate +1
Next
If nAggiornate > 0 Then
MsgBox "Aggiornate " & nAggiornate & "estrazioni." & vbCrLf & "Chudere il file excel salvando le modifiche e riaprirlo"
End If
Else
MsgBox "Con la data " & sLastData & " non è stata trovata l'estrazione nell'archivio del programma"
End If
Else
MsgBox sLastData & " data non riconosciuta"
End If
Else
MsgBox "Errore apertura foglio excel",vbCritical
End If
xlApp.visible = True
' da fare alla fine della scrittura del foglio per liberare risorse
'xlSheet.save
'xlBook.Close
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
Function OpenExcelFile(xlApp,xlBook,xlSheet,sFile)
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open(sFile)
Set xlBook = xlApp.Workbooks(1)
Set xlSheet = xlBook.Sheets("Estrazioni")
If Err = 0 Then
OpenExcelFile = True
End If
End Function
Function GetUltimaDataIns(xlSheet ,nLastRiga)
Dim k , j
Dim sData
nLastRiga =0
Messaggio ("Cerca ultima data ..")
k = 3
Do While xlSheet.cells( k ,1) <> ""
k = k + 20
Loop
For j = k To 3 Step -1
If xlSheet.cells( j ,1)<> "" Then
sData = xlSheet.cells( j ,1)
nLastRiga = j
Exit For
End If
Next
If sData <> "" Then
Dim aV
aV = Split (sData , "-")
GetUltimaDataIns = Trim(aV(1))
Else
GetUltimaDataIns = ""
End If
End Function
Function FormattaNumeri (aNum)
Dim k
Dim sRet
sRet = ""
For k = 1 To 5
sRet = sRet & FormatSpace(aNum(k) ,2,True ) & " "
Next
FormattaNumeri = Trim(sRet)
End Function
