un aiuto

[vincenzo4221]

NON ricordo e non trovo la discussione dove hai allegato questo tuo script che aggiornava spaziometria , non mi ricordo i passaggi necessari, ma funzionava, (alla stregua di altri aggiornamenti ad esempio evidenze.xls, ricordi?) finora utilizzavo l'aggiornamento manuale , ma ora sono rimasto un pò indietro.
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