ARCHIVIO

[Amedeo1972]

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/

 

[Amedeo1972]

Troppo difficile?

 

[Mike58]

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

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

 

[Amedeo1972]

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.

 

[salvo50]

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

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!