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 28 giugno 2025
    Bari
    41
    76
    54
    04
    17
    Cagliari
    34
    52
    84
    54
    55
    Firenze
    21
    60
    89
    51
    03
    Genova
    36
    40
    46
    03
    73
    Milano
    32
    80
    01
    68
    12
    Napoli
    63
    34
    22
    85
    10
    Palermo
    21
    85
    64
    15
    65
    Roma
    48
    25
    42
    47
    50
    Torino
    51
    25
    14
    20
    28
    Venezia
    82
    48
    73
    53
    29
    Nazionale
    46
    55
    10
    32
    44
    Estrazione Simbolotto
    Napoli
    25
    01
    41
    45
    38
Indietro
Alto