CIAO QUALCUNO MI PUO AIUTARE

[trivellatomariotretre33]

COME DEVO AGGIORNARE EvidenzeLottoNew[0.1.4]
GRAZIE ANTICIPATAMENTE,

 

[chicco3]

Ciao Trivellato eccoti lo script.

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("",".xlsb")
   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

 

[trivellatomariotretre33]

CIAO chicco3 COME USO PER AGGIORNARE
QUANDO VADO AD APRILE LA CARTELLA DOVE O IL FILE EXEL NON ME LO VISUALIZZA E NON PROCEDO .
TI ALLEGO TX POTRESTI FARMELO IN QUESTO MODO UNO SCRIPT CHE FACCIO COPIA E INCOLLO GRAZIE CHICCO3.

 

[chicco3]

Ciao Trivellato non riesco a farti lo script che tu chiedi in quanto non so farlo.Vedi che il file che hai te finisce con l'estensione xls, mentre se tu guardi nello script finisce con xlsb togli la b e vedrai che te lo aggiorna oppure rinomina il tuo con la "b" finale come da immagine. Se c'è qualcosa chiedi pure.Ciao

 

[trivellatomariotretre33]

lo gia fatto chicco ma non me lo visualizza perche la mia e la versione EvidenzeLottoNew[0.1.4]
e non va se mi puoi allegare la tua grazie chicco.3

 

[chicco3]

Ciao Trivellato ci avevo già pensato ma qui non mela fa allegare come faccio????

 

[trivellatomariotretre33]

CIAO CHICCO3 GRAZIE PER LA TUA DISPONIBILITA' TI ALLEGO IL LINK DOVE CARICARLO E DOPO CHE LO AI CARICATO DEVI COPIARE IL LINK DI SCARICO E METTERLO POSTATO COSI IO LO SCARICO GRAZIE CHICCO3 RESTO IN ATTESA .
ECCO IL LINK
https://www.mediafire.com/?fbclid=IwAR2RX0Ki0CdfqiSPdjWnxZg5PRL72EHW_qqjTkEnrPyfvOp8yDg-ZNR1PnI

 

[chicco3]

Ciao trivellato prova non sono un mago su queste cose vedi se va bene

 

[trivellatomariotretre33]

CIAO CHICCO3 GRAZIE LO SCARICATO MA NON SO AGGIORNARLO ME LO POTRESTI AGGIORNARE E INVIARMELO CON LO STESSO LINK GRAZIE DI CUORE.

 

[chicco3]

scaica pure

 

[trivellatomariotretre33]

grazie di cuore CHICCO3 sei stato fantastico adessso se vuoi puoi rimuovere il link
una stretta di mano chilometrica ciao.

 

[chicco3]

Ma scherzi trivellato è un piacere aiutare quando si può. Per curiosità a che ti serve è un vecchio programma? ciao buona serata

 

[trivellatomariotretre33]

grazie Chicco3

 

[chicco3]

Buongiorno trivellato va bene l'ultimo.

 

[trivellatomariotretre33]

SI CHICCO3 VA BENE GRAZIE SEI STATO FANTASTICO.