Novità

ARCHIVIO

Amedeo1972

Member
Ciao a tutti vorrei una mano siccome ho dei file excel che le macro non si possono piu aggiornare vorrei sapere se su spaziometria si potrebbe fare uno script in modo da darmi le estrazioni come mi servono cosi che possa fare il copia e incolla su excel per aggiornarlo , vi metto una foto per farvi capire come mi serve che mi venga restituito l'archivio , grazie a tutti quelli che vogliono aiutarmi , ciao.

https://s1.postimg.org/7n2e9bbimn/ARCHIVIO.jpg

https://postimg.org/image/1qdu2auznv/
 
Si Amedeo esistono degli script che possono scrivere le estrazioni direttamente in Excel, visto che devi solo incollare le estrazioni con delle piccole accortezze potresti modificarlo ad oc.

Pensa che si potrebbe utilizzarlo per far scrivere su un file esistente ed alla riga che ti serve aggiornare, ma visto che t serve per copiare le estrazioni, già cosi è adatto al tuo scopo.

provalo

Codice:
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
 
Grazie infinite Mike58 sicuramente cerchero' di imparare a smanettare per fare qualche piccola modifica per adattare bene le estrazioni a qualche foglio excel , comunque lo script e' perfetto , ti ringrazio tantissimo , ciao.
 
Mike58;n2056299 ha scritto:
Si Amedeo esistono degli script che possono scrivere le estrazioni direttamente in Excel, visto che devi solo incollare le estrazioni con delle piccole accortezze potresti modificarlo ad oc.

Pensa che si potrebbe utilizzarlo per far scrivere su un file esistente ed alla riga che ti serve aggiornare, ma visto che t serve per copiare le estrazioni, già cosi è adatto al tuo scopo.

provalo

Codice:
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

Bello, troppo forte, adesso vedo se riesco a inserire una sola ruota, a piacere.

Ciao!
 
Ultima modifica:

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 18 ottobre 2025
    Bari
    23
    03
    54
    34
    30
    Cagliari
    49
    14
    25
    09
    37
    Firenze
    32
    45
    15
    59
    29
    Genova
    03
    66
    68
    90
    85
    Milano
    88
    15
    21
    41
    27
    Napoli
    79
    72
    84
    27
    01
    Palermo
    23
    03
    73
    25
    04
    Roma
    11
    67
    24
    13
    59
    Torino
    72
    59
    84
    75
    26
    Venezia
    81
    08
    18
    76
    25
    Nazionale
    58
    69
    62
    17
    70
    Estrazione Simbolotto
    08
    26
    28
    22
    40
Indietro
Alto