Modifica file xls da access per formattazione

Question

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

Answer 1

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

Next

 With oExcel

         .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.

Answer 2

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.

Answer 3

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.

Answer 4

ciao Frank&Lav,

non ho testato il codice e mi fido sia funzionante...generalmente l'istanza resta appesa perche' gli oggetti creati non vengono distrutti.

Prima della chiusura della routine prova a distruggere gli oggetti che crei 

   Dim oBook As Object

   Dim oSheet As Object

   Dim oExcel As Object

settandoli a nothing :

set oBook=nothing

set oSheet=nothing

set oExcel =nothing

dopo la chiusura del loop e prima della distruzione dell'istanza dell'applicazione Excel e dopo il salvataggio dell workbook.

Spero sia chiaro… :-).

Manca la gestione errori, se inserisci imposta il settaggio a nothing nell'etichetta exit sub.

Facci sapere.

Ciao, Sandro.

ps non sono convintissimo serva il loop per quello di cui hai bisogno...ma devo testare la routine, in serata...

intanto vediamo se le indicazioni che ti ho suggerito sono efficaci poi pensiamo, in caso, al resto...!

Ciao Sandro, 

grazie per la risposta e per la celerità! :)

Ho inserito il codice che mi hai detto: 

"

  ….

   oBook.Save

   oBook.Close True

   oExcel.Quit

   Set oBook = Nothing

   Set oSheet = Nothing

   Set oExcel = Nothing

End Sub

"

Purtroppo niente da fare: l'istanza rimane aperta (lo vedo dal task manager) e mi genera lo stesso errore di prima. Ma solo al secondo passaggio dell'applicazione.

PS: il ciclo l'ho impostato per leggere tutte le righe del file e formattarle in base al contenuto delle celle. Non so se c'è un metodo migliore… (forse potrei usare un file di copia per impostare una formattazione condizionale)

Grazie ancora

Francesco

Answer 5

ciao Frank&Lav,

non ho testato il codice e mi fido sia funzionante...generalmente l'istanza resta appesa perche' gli oggetti creati non vengono distrutti.

Prima della chiusura della routine prova a distruggere gli oggetti che crei 

   Dim oBook As Object

   Dim oSheet As Object

   Dim oExcel As Object

settandoli a nothing :

set oBook=nothing

set oSheet=nothing

set oExcel =nothing

dopo la chiusura del loop e prima della distruzione dell'istanza dell'applicazione Excel e dopo il salvataggio dell workbook.

Spero sia chiaro… :-).

Manca la gestione errori, se inserisci imposta il settaggio a nothing nell'etichetta exit sub.

Facci sapere.

Ciao, Sandro.

ps non sono convintissimo serva il loop per quello di cui hai bisogno...ma devo testare la routine, in serata...

intanto vediamo se le indicazioni che ti ho suggerito sono efficaci poi pensiamo, in caso, al resto...!