Ciao, ho questo problema: devo formattare un file xls in base a delle regole. Il mio codice non mi dà problemi: la modifica viene effettuata con successo. Il problema è che rimane aperto il processo Excel nel task manager; quindi se rilancio la medesima funzione mi viene segnalato un errore: errore di run time '1004': metodo 'cells' dell'oggetto '_Global' non riuscito Il codice che uso è questo: Private Sub modificaLayOutFile_LUN() Dim row As Integer Dim lune as string Dim saba as string Dim nomeFileSalvato as string lune = Year(txtDataLun) & "." & Month(txtDataLun) & "." & Day(txtDataLun) saba = Year(txtDataSab) & "." & Month(txtDataSab) & "." & Day(txtDataSab) nomeFileSalvato = "c:\pianificazione\settimana_" & lune & "_" & saba & ".xlsx" Dim oBook As Object Dim oSheet As Object Dim oExcel As Object Set oExcel = CreateObject("Excel.Application") Set oBook = oExcel.Workbooks.Open(nomeFileSalvato) '--------------------------------------------------- ' AGISCO SUL PRIMO FOGLIO: LUNEDI' '--------------------------------------------------- Set oSheet = oBook.Worksheets(1) row = 2 '--------------------------------------------------- ' Loop per modifica del file '--------------------------------------------------- Do Until Cells(row, 7).Value = "" '----------------------------------------------------------- ' Celle con A '----------------------------------------------------------- If Cells(row, 7).Value = "A" Then Range(Cells(row, 7), Cells(row, 7)).Select Selection.Font.Bold = True 'GRASSETTO With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = RGB(255, 255, 0) 'giallo carico .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection .HorizontalAlignment = xlCenter 'centrato End With End If row = row + 1 Loop oBook.Save oBook.Close True oExcel.Quit End Sub Grazie Francesco

Ciao Francesco, […] PS: ho caricato il tuo nuovo codice, funziona. Ma rispetto al precedente è molto più lento… […] ho misurato le performance con A10 a 64 bit e con : 4 fogli da 22828 celle, i tempi si allungano di 1500 msec. 4 fogli da 89969 celle, i tempi raddoppiano. L'aumento è esponenziale a in base alle celle, con la seconda routine controlli il valore cella per cella nel range, con la prima la formattazione condizionale agisce in modo più efficiente. Io però...applicherei in ogni caso la seconda perchè anche se più lenta la manipolazione delle celle può essere celata per quanto riguarda la modalità dalla creazione un un file ACCDE.Infatti con un accde i tempi non raddoppiano ma aumentano del 50% credo miglioramento notevolissimo. 3D davvero molto interessante…!!! ciao e buona serata. Sandro. ps. ulteriore importante improvement delle performance spostando la fase di formattazione una sola volta e alla fine del loop delle celle, prova...! Do While Not rst.EOF() For Each Cell In Rng If Cell.Value = rst.Fields("valoreTXT").Value Then If FoundCells Is Nothing Then Set FoundCells = Cell Else Set FoundCells = oExcel.Union(FoundCells, Cell) End If End If Next If Not FoundCells Is Nothing Then With FoundCells.Interior .Pattern = 1 .PatternColorIndex = -4105 ' xlAutomatic .Color = rst.Fields("backColorLong") .TintAndShade = 0 .PatternTintAndShade = 0 End With With FoundCells .Font.Bold = True .HorizontalAlignment = -4108 .Font.Color = rst.Fields("FontColorLong") End With End If Set FoundCells = Nothin g rst.MoveNext Loop

Modifica file xls da access per formattazione

Risposta accettata dall'autore della domanda

Anonimo

ciao Francesco,

testa questa routine :

Private Sub test()

On Error GoTo errorHandler

Dim lune As String

Dim saba As String

Dim Rng As Object ' Excel.Range

Dim oBook As Object ' Excel.WorkBook

Dim oSheet As Object ' Excel.WorkSheet

Dim oExcel As Object ' Excel.Application

Dim nomeFileSalvato As String

Dim lngLastRow As Long

Const strClass As String = "Excel.Application"

'lune = Year(txtDataLun) & "." & Month(txtDataLun) & "." & Day(txtDataLun)

'saba = Year(txtDataSab) & "." & Month(txtDataSab) & "." & Day(txtDataSab)

' prova a sostituire le istruzioni di cui sopra come segue :

'lune =format$(txtDataLun,"yyyy.m.d")

'saba=format$(txtDataSab,"yyyy.m.d")

nomeFileSalvato = "c:\pianificazione\settimana_" & lune & "_" & saba & ".xlsx"

On Error Resume Next

Set oExcel = GetObject(, strClass)

If Err.Number = 429 Then

Set oExcel = CreateObject(strClass)

End If

On Error GoTo 0

Set oBook = oExcel.Workbooks.Open(nomeFileSalvato)

For Each oSheet In oBook.sheets

On Error Resume Next

lngLastRow = LastRow(oSheet)

With oSheet

Set Rng = .Range("G2:AA" & lngLastRow)

Rng.FormatConditions.Delete

End With

On Error GoTo 0

Dim cond1 As Object, cond2 As Object, cond3 As Object

Dim cond4 As Object, cond5 As Object, cond6 As Object

Dim cond7 As Object, cond8 As Object, cond9 As Object

Dim cond10 As Object, cond11 As Object, cond12 As Object

Dim cond13 As Object, cond14 As Object, cond15 As Object

Dim cond16 As Object, cond17 As Object, cond18 As Object

With Rng.FormatConditions

Set cond1 = .Add(1, 3, "A")

Set cond2 = .Add(1, 3, "X")

Set cond3 = .Add(1, 3, "2")

Set cond4 = .Add(1, 3, "R")

Set cond5 = .Add(1, 3, "S")

Set cond6 = .Add(1, 3, "T")

Set cond7 = .Add(1, 3, "O")

Set cond8 = .Add(1, 3, "-")

Set cond9 = .Add(1, 3, "M")

Set cond10 = .Add(1, 3, "C")

Set cond11 = .Add(1, 3, "F")

Set cond12 = .Add(1, 3, "MR")

Set cond13 = .Add(1, 3, "SS")

Set cond14 = .Add(1, 3, "TP")

Set cond15 = .Add(1, 3, "PT")

Set cond16 = .Add(1, 3, "RO")

Set cond17 = .Add(1, 3, "FR")

Set cond18 = .Add(1, 3, "SR")

End With

With cond1

.Interior.Color = 65535 ' giallo

.Font.Color = 0 ' nero

End With

With cond2

.Interior.Color = 255 ' Rosso

.Font.Color = 16777215 ' bianco

End With

With cond3

.Interior.Color = 15631086 ' viola

.Font.Color = 0 ' nero

End With

With cond4

.Interior.Color = 8388352 ' verde

.Font.Color = 0 ' nero

End With

With cond5

.Interior.Color = 5219839 ' marrone chiaro

.Font.Color = 0 ' nero

End With

With cond6

.Interior.Color = 9445584 ' viola

.Font.Color = 16777215 ' bianco

End With

With cond7

.Interior.Color = 2841227 ' marrone scuro

.Font.Color = 16777215 ' bianco

End With

With cond8

.Interior.Color = 15453831 ' azzurro

.Font.Color = 0 ' nero

End With

With cond9

.Interior.Color = 0 ' nero

.Font.Color = 16777215 ' bianco

End With

With cond10

.Interior.Color = &H808080 ' grigio

.Font.Color = &H0 ' nero

End With

With cond11

.Interior.Color = 4557568 ' verde acceso

.Font.Color = 0 ' nero

End With

With cond12

.Interior.Color = 7794176 ' verdino

.Font.Color = 16777215 ' bianco

End With

With cond13

.Interior.Color = 14772544 ' Navy

.Font.Color = 16777215 ' bianco

End With

With cond14

.Interior.Color = 13224397 ' silver

.Font.Color = 9445584 ' purple

End With

With cond15

.Interior.Color = 16448255 ' grigio

.Font.Color = 9445584 ' purple

End With

With cond16

.Interior.Color = 4356590 ' marron

.Font.Color = 9445584 ' purple

End With

With cond17

.Interior.Color = 3706510 ' Oliva

.Font.Color = 9445584 ' purple

End With

With cond18

.Interior.Color = 65280 ' giallo/verde

.Font.Color = 9445584 ' purple

End With

.displayAlerts = False

oBook.Close SaveChanges:=True _

, FileName:=nomeFileSalvato

.displayAlerts = True

End With

VBA.MsgBox prompt:="Ho finito.", _

buttons:=vbInformation + vbOKOnly, _

title:="Info"

exitErrorHandler:

Set cond1 = Nothing

Set cond2 = Nothing

Set cond3 = Nothing

Set cond4 = Nothing

Set cond5 = Nothing

Set cond6 = Nothing

Set cond7 = Nothing

Set cond8 = Nothing

Set cond9 = Nothing

Set cond10 = Nothing

Set cond11 = Nothing

Set cond12 = Nothing

Set cond13 = Nothing

Set cond14 = Nothing

Set cond15 = Nothing

Set cond16 = Nothing

Set cond17 = Nothing

Set cond18 = Nothing

Set oSheet = Nothing

Set oBook = Nothing

oExcel.Quit

Set oExcel = Nothing

Exit Sub

errorHandler:

With Err

MsgBox "ERR#" & CStr(.Number) _

& vbNewLine & .Description _

, vbOKOnly Or vbCritical

End With

Resume exitErrorHandler

End Sub

ciao, Sandro.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

ciao Francesco,

prova a fornire qualche dettaglio specifico su condizioni/valori da verificare in base alla formattazione da applicare e vediamo come meglio procedere...

Ciao, Sandro.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

ciao Francesco,

[…]

ho provato con le tue modifiche ed ora è tutto ok!

Grazie!!!!!!

[…]

bene, ho preferito rivedere tutta una serie di aspetti.

Il loop e' un vincolo per valutare il valore contenuto nella cella, ma con il ciclo for … each l'esecuzione e' piu' efficiente/efficace, come in pratica nella totalita' dei casi in cui si vede ciclare una collection, nativa o customizzata di oggetti.

Nota bene tra il resto anche questa stralcio di codice :

On Error Resume Next

Set oExcel = GetObject(, strClass)

If Err.Number = 429 Then

Set oExcel = CreateObject(strClass)

End If

On Error GoTo 0

Quando devi riferirti a istanze degli altri applicativi facenti parte la suite office da Access o dagli altri ( a parte Access), e' sempre bene valutare se c'e' gia' un'instanza attiva per quell'applicativo, e solo se non c'e' accenderne una....per come procedevi ad ogni esecuizone accendevi tout court un"istanza nuova :-)

In realta' le righe di cui sopra andrebbero ulteriormente implementate per rendere rigorosa e robusta la logica teste' spiegata, per ora restiamo sul semplice...! ;-)

[…]

? Mi spiego: io dovrei formattare più fogli e più colonne a seconda del loro valore… quindi dovrei replicare quello che hai fatto tu ma x volte

[…]

cosa cambia nel caso in cui la stessa routine debba essere applicata a piu' workbooks?

Ovviamente il fatto di non volere aprire manualmente ( credo ) ogni singolo workbook ed il range di riferimento qualora non sia sempre quello che hai indicato nel tuo primo post.

Assumendo per ora lo scenario in cui la colonna da formattare sia sempre la stessa, valuta un fileDialog per selezionare tutti i workbooks a cui devi applicare la formattazione indicata, memorizza il relativo path in un array e "passa" in loop l'apertura e la formattazione per ogni path che corrisponde a un file di xls contenuto nell'array.

Spero sia chiaro.

[…]

PS: Cosa intendi quando dici che la sto testando senza access?

[…]

mancavano dal mio punto di vista i riferimenti agli oggetti di Excel, da qui l'osservazione.

[…]

Scusa la mia ignoranza...

[…]

tranqui, siamo qui per darci una mano l'un l'altro.

Facci sapere.

Ciao, Sandro.

0 commenti

Modifica file xls da access per formattazione

17 risposte aggiuntive