Per LUIGI

[vincenzo4221]

 

[vincenzo4221]

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

 

[LuigiB]

probabilmente prima avevi office a 32 bit e ora ce l hai a 64

dovunque vedi scritto

Private Declare Sub

sostituisci con

Private Declare PtrSafe Sub



salva i l file excel e chiudilo. Poi riprova lo script

 

[vincenzo4221]

 

[vincenzo4221]

TROVOTROVO scritto solo "Private declare function" inserisco comunque "PtrSafe" prima di function? mentre se trovo solo "private declare" non inserisco nulla , va bene?

 

[vincenzo4221]

TROVOTROVO scritto solo "Private declare function" inserisco comunque "PtrSafe" prima di function? mentre se trovo solo "private declare" non inserisco nulla , va bene? mi rispondi x favore

 

[LuigiB]

declare

dopo declare e prima della parola successiva devi sempre scrivere ptrSafe

 

[vincenzo4221]

GRAZIE! riuscito...solo in parte però , in quanto il foglio excel non riesce ad eseguire tutte le operazioni, insomma qualche foglio non va avanti......questo perché la DLL "registradll" non è stata correttamente registrata, nemmeno con l'ausilio del prompt dei comandi , suggerito da una pagina internet..come fare?

infatti ad ogni apertura di "evidenze" riesce la finestra (Colorata in giallo e rosso) che cliccandola, dovrebbe far registrare le .DLL ma la "Registra.dll" , proprio non ne vuole sapere...riprovo a vedere se ho saltato qualke passaggio iniziale....

 

[LuigiB]

Boh non ricordo a cosa serva quella del ne ho intenzione di vederlo. Saluti

 

[vincenzo4221]

Non ti ho chiesto di andare a vedere cosa significasse, capisco che x tutti , il tempo è poco... ma solo di suggerire strade se ve ne sono alternative al prompt....ciao e grazie x il " PtrSafe"