Restituzione di più valori da un foglio all'altro vincolato ad una ricerca

[DadavaPartecipante Dadava]

PS ho messo OpenAfterPublish:=False peche con true mi andava a stampare direttamente senza aprire il file pdf...

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Dadava ha scritto:

ecco mi hai fatto risanguinare il naso

Oddio   

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Dadava ha scritto:

agiungere prima la stampa pdf di A1:T54

Ma di un altro foglio, immagino.
Imposta l'area di stampa del primo foglio.
Imposta l'area di stampa del secondo foglio.
Crea una selezione dei due fogli con l'istruzione di Array che ho mostrato poco fa.
Dai il comando di esportazione.

[DadavaPartecipante Dadava]

vecchio frac ha scritto:

Ma di un altro foglio, immagino. Imposta l'area di stampa del primo foglio.
Imposta l'area di stampa del secondo foglio.
Crea una selezione dei due fogli con l'istruzione di Array che ho mostrato poco fa.
Dai il comando di esportazione.

non smette di sanguinare.... non saprei in che riga aggiungerlo e come aggiungerlo...  ne come scriverlo nel codice indicando le celle da stampare... 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Dadava ha scritto:

non saprei in che riga aggiungerlo e come aggiungerlo

Adesso devo staccare un attimo. Rivedo più tardi se hai pazienza. Ma non è complicato: nel medesimo codice che hai inviato prima, il codice già scritto va bene, basta solo fare riferimento ai due fogli interessati impostando per ciascuno la propria area di stampa e le impostazioni di pagesetup. Prima di esportare crei una selezione di fogli con Array.

Così avrai un solo codice che fa tutto e risparmi un pulsante   

 

[DadavaPartecipante Dadava]

Diciamo che per ora ho fatto due pulsanti nelle pagine attive (non so come richamare un altra pagina in quel cod) con la stampa in due pdf diversi.... Ad ora quello che avete fatto mi pare più che un successo.... poi se ti va dopo, senza alcuna furia e ne hai voglia aggiorni la macro, ma ti ripeto è solo una chicca in più.... grazie ancora davvero.

[LucaSRPartecipante LucaSR Karma: 15 pts]

vecchio frac ha scritto:

Esempio, raggruppo i primi due fogli e li esporto:

workSheets(Array(worksheets(1).name, worksheets(2).name)) selection.exportasfixedformat xltypepdf, "c:\users\.....\desktop\pippo.pdf"

M'inchino    a tanta saggezza   

A parte gli scherzi, ne ho imparata un'altra   

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

LucaSR ha scritto:

a tanta saggezza 

Ma che saggezza... naturalmente alla prima istruzione manca un .Select ... altrimenti a cosa si riferisce il Selection successivo?   
Inoltre non è nemmeno del tutto corretto così.
La forma corretta è Thisworkbook.Activesheet perchè la selezione è considerata un foglio attivo.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Eccoti il codice.

Option Explicit

Sub EsportaPdf()
Dim datada As String
Dim dataa As String

    datada = Format(Foglio2.Range("B2"), "ddd-dd-mmm")
    dataa = Format(Foglio2.Range("B3"), "ddd-dd-mmm")
        
    With Foglio1.PageSetup
        .Orientation = xlLandscape
        .PrintArea = "A1:T54"
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
    End With
    With Foglio2.PageSetup
        .Orientation = xlLandscape
        .PrintArea = "A1:R77"
        .Zoom = False
        .FitToPagesTall = False
        .FitToPagesWide = 1
    End With

    Worksheets(Array(Foglio1.Name, Foglio2.Name)).Select
    ThisWorkbook.ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:="/Users/XXXXX/Documents/OrarioDipendenti/" & datada & " - " & dataa & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
        
    Foglio1.Select
    
End Sub

[DadavaPartecipante Dadava]

vecchio frac ha scritto:

Ci ho messo meno di quello che temevo e comunque non ho letto l'ultimo post di Dadava.

Houston abbiamo un problema..... se provi a mettere un dipendente dal venerdì alla domenica compresi non gli inserisce nella tabella... nell'esempio che hai postato te hai provato a compilare solo i primi tre gg ed infatti funziona ma quelli dopo no..... pensavo avessi fatto qualche errore ma ho riscaricato il file originale che avevi mandato e già da li fa questo errore...

[LucaSRPartecipante LucaSR Karma: 15 pts]

Allega qualche immagine, vediamo se riesco ad aiutarti senza Office   

[DadavaPartecipante Dadava]

Nei due file si vede che il dip 1 è presente tutti i giorni, ma avviando la macro "Compila Specchietto" lui compila solo dal lunedì al Giovedì non compilando da venerdì a domenica compresi...

questo il cod

 

Option Explicit

Sub compila_specchietto()
Dim ar As Range
Dim r As Range
Dim ce As Range
Dim d As Collection
Dim u As Collection
Dim v As Variant
Dim s As String
Dim m As String
Dim i As Long
Dim j As Long
Dim f As Range
Dim k As Integer
Dim h As Integer
Dim bExists As Boolean

    Application.ScreenUpdating = False
    
    Call pulisci_specchietto
    
    Set d = New Collection    'elenco completo dei dati per giornata
    Set u = New Collection    'elenco univoco dei dipendenti

    Foglio1.Activate    'attiva il foglio giornaliero
    
    'raccoglie i dati dal foglio settimanale
    Set r = Range("F4:F52,J4:J52,N4:N52")
    For Each ar In r.Areas
        For Each r In ar
            For Each ce In r
                s = Trim(ce)
                If s <> "" Then
                    i = i + 1
                    v = Split(Partition(ce.Row, 4, 52, 7), ":")(0)
                    'costruisce la lista dei dipendenti come un array di questi parametri, in ordine:
                    'nominativo, giornata, entrata, uscita, negozio
                    'la Collection si costruisce passando item e key
                    d.Add Array(s, CDate(Cells(v, 1)), CDate(ce.Offset(, -2)), CDate(ce.Offset(, -1)), Cells(1, ce.Column - 2)), "K" & (i)
                    'nella Collection "u" inserisce i nominativi univoci dei dipendenti
                    'se l'item esiste viene sollevato un errore intercettabile
                    On Error Resume Next
                    u.Add s, s
                    bExists = (Err.Number = 0)
                    On Error GoTo 0
                End If
            Next
        Next
    Next
    
    Foglio2.Activate
    
    'riversa tutto nel foglio riepilogo
    Set r = Range("C1:C500,I1:I500,O1:O500").SpecialCells(xlCellTypeFormulas)
    Set r = Union(Range("A1"), r)
    For Each v In u     'passa in rassegna i dati di ogni dipendente
        Set f = r.Find(What:=(u(v)), LookIn:=xlValues, After:=r.Cells(1))     'cella con nominativo dipendente
        For i = 1 To d.Count    'esamina la tabella dati e li spacchetta per dipendente
            If d(i)(0) = u(v) Then
                h = 0
                For k = 1 To 7  'individua la data nella colonna dei giorni
                    If f.Offset(k, -2) = d(i)(1) Then       'se trovata...
                        If f.Offset(k + h) <> "" Then h = h + 1
                        f.Offset(k + h) = d(i)(4) 'negozio
                        f.MergeArea.Cells(2).Offset(k + h) = FormatDateTime(d(i)(2), vbShortTime) 'entrata
                        f.MergeArea.Cells(3).Offset(k + h) = FormatDateTime(d(i)(3), vbShortTime) 'uscita
                        If h = 1 Then Exit For
                    End If
                Next
            End If
        Next
    Next

    Set d = Nothing
    Set u = Nothing
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    MsgBox "Ho terminato.", vbInformation, "Success"
    
End Sub

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Già, devo rivedere la routine che compila lo specchietto. La colpa è di quelle brutte celle unite relative ai giorni. Sorry

 

[DadavaPartecipante Dadava]

vecchio frac ha scritto:

Sorry

ci mancherebbe.... ho provato a spippolare ma a me sembravo tutto corretto...

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

La modifica è banale quanto l'errore (poichè le celle della settimana sono doppie, una per ognuno dei turni negozio, il conteggio non va da 1 a 7 ma da 1 a 14 a passi di 2).

Nella Sub compila_specchietto correggi la riga 62 da così:

For k = 1 To 7           'individua la data nella colonna dei giorni

a così:

For k = 1 To 14 Step 2   'individua la data nella colonna dei giorni

Poi in effetti potresti anche usare la mia nuova versione 4 dal momento che è ottimizzata, ma alla fine importa il risultato 🙂

[DadavaPartecipante Dadava]

è si in effetti era banale, come ho fatto a non pensarci....    (Sincerità:=False)

grazie mille!!! ora faccio un altro file con la tua seconda versione!

 

[DadavaPartecipante Dadava]

Ora ti lascio un po respirare buon @vecchiofrac... poi ti sfiderò a risolvere la più grande delle sfide.... compilare con un clic in maniera automatica gli orari.   tenendo conto dei parametri di ore dovute ed ore effettuate, di vicinanza ai punti vendita e priorità per giorno del numero di dipendenti..... ma lasciamo all'essere umano per ora il gusto di perderci ore  

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Allora meglio aprire una nuova discussione allegando l'ultimo file funzionante e chiarendo meglio il nuovo scenario ed obiettivo   

[DadavaPartecipante Dadava]

Vuoi veramente farlo?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Dadava ha scritto:

Vuoi veramente farlo?

In che senso? Non è un mio obiettivo...  Ma se hai un problema prima cerchi di risolverlo con le tue forze e se non riesci lo proponi qui e proviamo ad aiutarti.

[DadavaPartecipante Dadava]

ok grazie, cercherò di fare uno schema preciso di quello di cui avrei bisogno ed apro una discussione

[Autore]

Articoli