Buongiorno a tutti!
Premesso che non sono un drago di VB sto cercando di fare un programma che gestisca un elenco di dipendenti assunti e cessati prelevandoli da delle query
Il tutto funziona alla grande fino a quando bisogna importare i dati su excel (nel modello esistente).
Spero possiate aiutarmi


In pratica ho la routine RassIndet in un modulo. Tale modulo è salvato in un progetto access 2010.
Grazie ad una maschera richiamo RassIndet tramite un commandbutton e.
Tuttavia ho un problema piuttosto grosso:
il programma mi restituisce l'errore: "Errore di run-time '91' Variabile oggetto o variabile del blocco with non impostata"
Esattamente nella riga 75 colonna 1 ovvero il blocco di codice "CAMBIO GRAFICA CORPO RIGHE" con evidenziazione gialla di debug sul codice
Selection.Copy


Comportamento ancora più strano. Dopo questo errore faccio "fine" cioè interrompo l'esecuzione e senza cambiare assolutamente nulla rieseguo il programma
e tac! magicamente funziona!Poi lo eseguo un altra volta e mi restitusce l'errore di prima e cosi via. Cioè funziona alternato
Il che è un casino perchè dovrei automatizzare il tutto e non farlo manualmente


Di seguito il codice del modulo principale (quello con l'errore) e sotto di esso altri moduli minori richiamati in questo.
Spero davvero possiate aiutarmi non so più cosa fare


codice:
Option Compare Database


Public Sub RassIndet()    'Routine assunti indeterminato Dirigenti & Comparto


Dim rs As DAO.Recordset
Dim ex As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim i As Integer
Dim cognome As String
Dim nome As String
Dim matricola As String
Dim contadir As Integer
Dim contacom As Integer
Dim prog As Integer




'DIRIGENTI****************************************************************************


'apre excel
Set ex = New Excel.Application
ex.Visible = True 'metti false se non vuoi vedere excel a video


'apre il file xls
Set wb = ex.Workbooks.Open("F:\Asl2\AutomaticProject\AssuntiCessatiMensile.xls")


'seleziona il foglio 1
Set ws = wb.Worksheets(1)
ws.Activate


'cancello i dati esistenti dalla 3 riga del foglio
    ws.Range("A5:Z65536").ClearContents
    ws.Range("A5:Z65536").ClearFormats


'SCRITTURA DATI SU EXCEL apre un recordset con la tabella da esportare
Set rs = CurrentDb.OpenRecordset("tbl_assIndetD", DAO.dbOpenDynaset)
     
    Dim mese As String   'VERIFICA PERIODO RICHIESTO E STAMPA funzione: stampaperiodo
        If rs.EOF And ws.Cells(1, 1) = "" Then
            ws.Cells(1, 1) = "inserire mese selezionato"
            Else
            mese = rs("Dataassunzione")
            mese = Mid(mese, 4, 2)
            ws.Cells(1, 1) = stampaperiodo(mese)
        End If
        
    'loop sui record
    i = 3           'scrive dalla seconda riga
    
    Do Until rs.EOF
    'aggiorna un contatore
    i = i + 1
      
    'imposta la colonna A e B per la riga = i
    cognome = rs("Cognome")
    nome = rs("Nome")
    matricola = rs("Matricola")
    contadir = contadir + 1           'conteggio dirigenti
    
    ws.Cells(i, 1) = progr + 1                                                          'progressivo
    ws.Cells(i, 2) = cognome + " " + nome + " (" + matricola + ")"                      ' cognome nome (matricola)
    If rs("DescrizioneDisciplina") = "" Then                                            'profilo professionale
        ws.Cells(i, 3) = rs("DescrizionePosizione")
        Else
        ws.Cells(i, 3) = rs("DescrizionePosizione") + " - " + rs("DescrizioneDisciplina")
    End If
    ws.Cells(i, 4) = rs("DataAssunzione")                                               'data assunzione
    ws.Cells(i, 5) = rs("DescrizioneUnitaOrg")                                          'Struttura
    ws.Cells(i, 6) = rs("DescrizioneCausaleAssunzione")
    
    progr = progr + 1
            
        'CAMBIO GRAFICA CORPO RIGHE
    ws.Range(ws.Cells(4, 1), ws.Cells(4, 7)).Select  'sorgente copia grafica
    Selection.Copy
    ws.Range(ws.Cells(i, 1), ws.Cells(i, 7)).Select    'destinazione copia grafica
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
                      
    'prossimo record
    rs.MoveNext
    Loop
    
    i = i + 1 'memorizzo l'ultima cella scritta
         
    If i = 4 Then i = 5 'SALTO UNA RIGA SE LA QUERY E' VUOTA
        
    ws.Cells(i, 1) = graficariepilogo(i, i, 1, 3)   'GRAFICA RIEPILOGO riga1, riga 2, colonna1, colonna2
    ws.Cells(i, 1) = "Personale Dirigente: " & contadir 'conteggio dirigente
    
    
'chiude recordset
rs.Close


'salva file
wb.Save


'cancella variabili oggetto
Set rs = Nothing


'COMPARTO***********************************************************************************************


'SCRITTURA DATI SU EXCEL apre un recordset con la tabella da esportare
Set rs = CurrentDb.OpenRecordset("tbl_assIndetC", DAO.dbOpenDynaset)
    
    'loop sui record
    progr = 0
    Do Until rs.EOF
    'aggiorna un contatore
    i = i + 1
    
    'imposta la colonna A e B per la riga = i
    cognome = rs("Cognome")
    nome = rs("Nome")
    matricola = rs("Matricola")
    contacom = contacom + 1           'conteggio comparto
    
    ws.Cells(i, 1) = progr + 1                                                             'progressivo
    ws.Cells(i, 2) = cognome + " " + nome + " (" + matricola + ")"                      ' cognome nome (matricola)
    If rs("DescrizioneDisciplina") = "" Then                                            'profilo professionale
        ws.Cells(i, 3) = rs("DescrizionePosizione")
        Else
        ws.Cells(i, 3) = rs("DescrizionePosizione") + " - " + rs("DescrizioneDisciplina")
    End If
    ws.Cells(i, 4) = rs("DataAssunzione")                                               'data assunzione
    ws.Cells(i, 5) = rs("DescrizioneUnitaOrg")                                          'Struttura
    ws.Cells(i, 6) = rs("DescrizioneCausaleAssunzione")
    
    progr = progr + 1
    
     'CAMBIO GRAFICA CORPO RIGHE
    ws.Range(ws.Cells(4, 1), ws.Cells(4, 7)).Select  'sorgente copia grafica
    Selection.Copy
    ws.Range(ws.Cells(i, 1), ws.Cells(i, 7)).Select    'destinazione copia grafica
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
            
    'prossimo record
    rs.MoveNext
    Loop
    
    i = i + 1                                           'grafica riepiloghi
    ws.Cells(i, 1) = graficariepilogo(i, i, 1, 3)
    ws.Cells(i, 1) = "Personale Comparto: " & contacom
    i = i + 1                                           'grafica totali
    ws.Cells(i, 1) = graficatotali(i, i, 1, 3)
    ws.Cells(i, 1) = "TOTALE GENERALE: " & (contacom + contadir)




'chiude recordset
rs.Close




'Attivo foglio successivo
Set ws = wb.Worksheets(2)
ws.Activate


'salva file
wb.Save


'chiude file
wb.Close


'esce da excel
ex.Quit


'cancella variabili oggetto
Set rs = Nothing
Set ex = Nothing
Set wb = Nothing
Set ws = Nothing


MsgBox "Generazione Excel avvenuta con successo!", vbInformation, "Generazione excel"


End Sub




-----------------------------------------------
Function graficacorpo(rig As Integer, col As Integer)
    'CAMBIO GRAFICA RIGHE
   Range("A4:G4").Select
   Selection.Copy
   Range(Cells(i, 1), Cells(i, 7)).Select
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Range(Cells(i, 1), Cells(i, 7)).RowHeight = 54.75
    'GIA COMMENTATOApplication.CutCopyMode = False
    
End Function
------------------------------------------------
Function graficariepilogo(rig1 As Integer, rig2 As Integer, col1 As Integer, col2 As Integer)
 
 Range(Cells(rig1, col1), Cells(rig2, col2)).Select


'colori
   With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .RowHeight = 35.25
    End With
    Selection.Merge


End Function
-----------------------------------------------