DOMANDA Verifica routine VBA creata con IA

Pubblicità
geobeppe50

geobeppe50

Utente Attivo
Messaggi
13
Reazioni
1
Punteggio
36
Ciao a tutti e grazie in anticipo per l'eventuale aiuto,
ho creato, anzi ho fatto creare dall'IA, una routine che gestisca i turni di 10 gruppi nell'arco di un anno. Il concetto è questo ma sarò più chiaro e descrittivo se qualcuno si prenderà in carico questa patata bollente 😄.
In sostanza non riesco a far fare alla routine un paio di cosette quindi chiedo aiuto a chi ne sa più di me.
in attesa del volontario 😇 grazie di nuovo
geobeppe50
 
Ciao,
allora, se sei d'accordo, posto la mia domanda alla IA e la routine che mi ha generato e vi spiego quello che vorrei che mi facesse ma che non mi fa?
Attendo conferma e ringrazio
 
Ultima modifica:
geobeppe50 ha detto:
Ciao,
allora, se sei d'accordo, posto la mia domanda alla IA e la routine che mi ha generato e vi spiego quello che vorrei che mi facesse ma che non mi fa?
Attendo conferma e ringrazio
Clicca per espandere...
Basta che metti il codice e quello che vuoi fare e non fa.
 
Ok grazie, però vorrei iniziare con la richiesta che ho fatto all'IA seguita dalle cose che non sono riuscito ad ottenere, di seguito il codice.

Progettare una routine VBA che gestisca la svolta di dieci gruppi all'interno di un anno con cadenza settimanale e con queste caratteristiche: i turni vanno spalmati nell'arco dell'anno con cadenza settimanale, ogni settimana i gruppi dovranno slittare di un giorno quindi chi inizia di lunedi la settimana dopo avrà il martedi poi il mercoledi e così via e questo per ogni singolo gruppo, la data di inizio svolta cambia da gruppo a gruppo e dovrà esserci la possibilità di cambiarla ogni inizio anno con apposito modulo iniziale e quindi inserito manualmente e non calcolata automaticamente, non possono essere presenti più gruppi nella stessa giornata, ogni gruppo ha a disposizione un numero definito e non modificabile di giornate annuali, gruppo Cavicchioli giornate 46 con passo +8 partendo dalla data iniziale , gruppo Cipriani giornate 46 con passo +8 partendo dalla data iniziale, gruppo Stella giornate 25 con passo +16 partendo dalla data iniziale, gruppo Valli giornate 45 con passo +8 partendo dalla data iniziale, gruppo Dalla Fina giornate 23 con passo +16 partendo dalla data iniziale, gruppo Menegatti giornate 23 con passo +16 partendo dalla data iniziale, gruppo Bruschi giornate 23 con passo +16 partendo dalla data iniziale, gruppo A giornate 45 con passo +8 partendo dalla data iniziale, gruppo B giornate 46 con passo +8 partendo dalla data iniziale, gruppo Carroli giornate 44 con passo +8 partendo dalla data iniziale per un totale di 366 giorni, creare stampa formattata in pdf mese per mese del calendario, creare stampa formattata in pdf riepilogativa con tutte le date delle giornate assegnate ad ogni gruppo.

A questa routine, che per quello che ho chiesto va bene, dovrei aggiungere delle eccezioni che ho anche già provato ad aggiungerle ma inizia a sbagliare i conteggi quindi non capisco se sono inserite malamente le mie informazioni e se sono proprio ingestibili.

Quello che non riesco ad ottenere sono le eccezioni ovvero:

- gruppo Stella giornate 25 con passo +16 partendo dalla data iniziale ma con il vincolo della presenza solo di martedì quindi conseguente scambio della giornata diversa dal martedi con il gruppo che in quella settimana capita di martedi. (Spero si capisca!!!!)

- tutte le giornate del gruppo Carroli vanno riassegnate a 7 dei 9 gruppi rimanenti ovvero: 6 giornate al gruppo Cavicchioli, 7 giornate al gruppo Cipriani, 3 giornate al gruppo Dalla Fina, 3 giornate al gruppo Menegatti, 3 giornate al gruppo Bruschi, 14 giornate al gruppo “A”, 8 giornate al gruppo “B”. La riassegnazione sarà distribuita nei vari gruppi in modo che non ci siano concentrazioni di periodi per un singolo o più gruppi, è ammesso che a uno o più gruppi le date riassegnate concedano due giorni consecutivi.

E questo è il codice:
Codice: 
' --- PROCEDURA PRINCIPALE ---
Sub GeneraEStampaTutto()
    Dim wsPar come foglio di lavoro
  
    ' Verifica esistenza foglio Parametri
    In caso di errore, riprendi successivo
    Imposta wsPar = ThisWorkbook.Sheets("Parametri")
    In caso di errore vai a 0
  
    Se wsPar non è nulla allora
        MsgBox "Errore: Il foglio 'Parametri' non esiste!", vbCritical
        Esci da Sottotitoli
    Fine se

    Application.ScreenUpdating = False
  
    ' 1. Genera il Calendario
    Chiama CreazioneCalendarioBase
  
    ' 2. Esporta PDF Mensili
    Call EsportaPDFMensiliFormattati
  
    ' 3. Esporta PDF Riepilogo (con foglio visibile per debug)
    Chiama EsportaPDFRiepilogoFormattato
  
    Applicazione.ScreenUpdating = Vero
    MsgBox "Operazione completata con successo!" & vbCrLf & _
           "Controlla la cartella: " & ThisWorkbook.path, vbInformation
Fine sottotitolo

' --- CREAZIONE CALENDARIO ---
Sub privata CreazioneCalendarioBase()
    Dim wsCal come foglio di lavoro, wsPar come foglio di lavoro
    Dim gruppi, maxGiorni, passi
    Dim i As Integer, g As Integer, riga As Long
    Dim dInizio As Date, dCorr As Date
  
    Imposta wsPar = ThisWorkbook.Sheets("Parametri")
    In caso di errore, riprendi successivo
    Application.DisplayAlerts = False: Sheets("Calendario_2026").Delete: Application.DisplayAlerts = True
    In caso di errore vai a 0
    Imposta wsCal = ThisWorkbook.Sheets.Add: wsCal.Name = "Calendario_2026"
  
    gruppi = Array("Cavicchioli", "Cipriani", "Stella", "Valli", "Dalla Fina", "Menegatti", "Bruschi", "A", "B", "Carroli")
    maxGiorni = Array(46, 46, 25, 45, 23, 23, 23, 45, 46, 44)
    passi = Array(8, 8, 16, 8, 16, 16, 16, 8, 8, 8)
  
    wsCal.Range("A1:C1").Valore = Array("DATA", "GIORNO", "GRUPPO ASSEGNATO")
    riga = 2
  
    Per i = 0 a UBound(gruppi)
        dInizio = wsPar.Cells(i + 2, 2).Value
        dCorr = dInizio
        Per g = 1 A maxGiorni(i)
            wsCal.Cells(riga, 1).Value = dCorr
            wsCal.Cells(riga, 2).Value = UCase(Format(dCorr, "dddd"))
            wsCal.Cells(riga, 3).Valore = gruppi(i)
            dCorr = dCorr + passi(i)
            riga = riga + 1
        Prossimo g
    Il prossimo io
  
    wsCal.UsedRange.Sort Key1:=wsCal.Range("A2"), Order1:=xlAscending, Header:=xlYes
    wsCal.Columns("A:C").AutoFit
Fine sottotitolo

' --- TIMBRO MENSILI FORMATTATO ---
Private Sub EsportaPDFMensiliFormattati()
    Dim ws come foglio di lavoro: Imposta ws = Sheets("Calendario_2026")
    Dim m come intero
    Dim percorso As String: percorso = ThisWorkbook.path & "\Mensili_2026\"
    If Dir(percorso, vbDirectory) = "" Then MkDir percorso
  
    ' Formattazione estetica
    Con ws.Range("A1:C1")
        .Colore.Interno = RGB(0, 51, 102)
        .Font.Color = vbWhite
        .Font.Bold = Vero
    Termina con
  
    Per m = 1 a 12
        ws.AutoFilterMode = False
        ws.UsedRange.AutoFilter Campo:=1, Criteria1:=">=" & CDbl(DateSerial(2026, m, 1)), _
                                 Operatore:=xlAnd, Criteria2:="<=" & CDbl(DateSerial(2026, m + 1, 0))
      
        Con ws.PageSetup
            .PrintTitleRows = "$1:$1"
            .CenterHeader = "&""Arial,Bold""CALENDARIO TURNI - MESE " & m & " / 2026"
            .CenterFooter = "Pagina &P di &N"
            .Orientamento = xlRitratto
        Termina con
      
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=percorso & "Mese_" & Format(m, "00") & ".pdf"
    Prossimo m
    ws.AutoFilterMode = False
Fine sottotitolo

' --- RIEPILOGO FORMATTATO (CORRETTO) ---
Private Sub EsportaPDFRiepilogoFormattato()
    Dim wsOrig come foglio di lavoro: imposta wsOrig = Sheets("Calendario_2026")
    Dim wsRiep As Worksheet
    Dim gruppi, g, col As Integer
  
    gruppi = Array("Cavicchioli", "Cipriani", "Stella", "Valli", "Dalla Fina", "Menegatti", "Bruschi", "A", "B", "Carroli")
  
    In caso di errore, riprendi successivo
    Application.DisplayAlerts = False: Sheets("Riepilogo_Finale").Delete: Application.DisplayAlerts = True
    In caso di errore vai a 0
    Imposta wsRiep = Fogli.Aggiungi: wsRiep.Name = "Riepilogo_Finale"
  
    colonna = 1
    Per ogni g In gruppi
        wsRiep.Cells(1, col).Value = UCase(g)
        wsOrig.AutoFilterMode = False
        wsOrig.UsedRange.AutoFilter Campo:=3, Criteria1:=g
      
        ' Copia data
        wsOrig.Range("A2:A1000").SpecialCells(xlCellTypeVisible).Copy
        wsRiep.Cells(2, col).PasteSpecial Incolla:=xlPasteValues
        colonna = colonna + 1
    Prossimo g
  
    ' Formattazione Riepilogo
    Con wsRiep.UsedRange
        .Colonne.Adattamento automatico
        .Borders.LineStyle = xlContinuous
        .Font.Name = "Calibri"
        .Dimensione carattere = 10
        .NumberFormat = "gg/mm/aaaa"
        .Allineamento orizzontale = xlCenter
    Termina con
  
    Con wsRiep.Rows(1)
        .Colore interno = RGB(192, 0, 0)
        .Font.Color = vbWhite
        .Font.Bold = Vero
    Termina con
  
    ' Configurazione Stampa Riepilogo
    Con wsRiep.PageSetup
        .Orientamento = xlPaesaggio
        .Zoom = Falso
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .TopMargin = Application.InchesToPoints(0.5)
        .CenterHeader = "&""Arial,Bold""RIEPILOGO ANNUALE ASSEGNAZIONI GIORNATE - 2026"
    Termina con
  
    ' Generazione PDF Riepilogo
    wsRiep.ExportAsFixedFormat Tipo:=xlTypePDF, _
        Nome file:=ThisWorkbook.percorso & "\Riepilogo_Annuale_2026.pdf", _
        Qualità:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnoraAreaStampa:=Falso, _
        OpenAfterPublish:=False
      
    wsOrig.AutoFilterMode = False
Fine sottotitolo
Grazie nuovamente

P.S. Aggiungo i parametri
Gruppo Data Inizio Giornate Max Passo
Cavicchioli 04/01/2026 46 8
Cipriani 01/01/2026 46 8
Stella 06/01/2026 25 16
Valli 05/01/2026 45 8
Dalla Fina 10/01/2026 23 16
Menegatti 13/01/2026 23 16
Bruschi 02/01/2026 23 16
A 07/01/2026 45 8
B 03/01/2026 46 8
Carroli 8/01/2026 44 8
 
Ultima modifica da un moderatore:
Pubblicità
Pubblicità
Indietro
Top