stamapare fogli

Hai un problema con Excel?

Nuova discussione

stamapare fogli
di Peppe (utente non iscritto) data: 18/05/2016 10:10:36
Buongiorno. In una cartella ho circa 500 file Excel, ognuno dei quali presenta 25 fogli; ho necessità di stampare solo alcuni fogli di tutti i file (foglio 2, foglio 3, foglio 4, foglio 6, foglio 12, foglio 13); è possibile farlo in automatico con una macro, senza la necessità di aprire e chiudere i singoli file?. Grazie a tutti.

di alfrimpa data: 18/05/2016 12:14:04
Ciao Peppe

Ti ho scritto le due macro che vedi sotto.

La prima dovrebbe fare quello che hai chiesto per tutti i file contenuti nella directory specifica.

La seconda è un test per provare su un singolo file; se va bene puoi lanciare la prima

Sub StampaFogli()
Dim myPath As String
Dim myFile As String
Application.ScreenUpdating = False
myPath = "C:TuoPercorso"   ' <========= Da modificare con il tuo percorso
myFile = Dir(myPath)
Do Until myFile = ""
    Workbooks.Open myPath & myFile
    ActiveWorkbook.Sheets(2).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(3).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(4).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(6).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(12).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(3).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Close
    myFile = Dir()
Loop
Application.ScreenUpdating = True
End Sub

Sub ProvaStampa()
    ActiveWorkbook.Sheets(2).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(3).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(4).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(6).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(12).Select
    ActiveSheet.PrintOut Copies:=1
    ActiveWorkbook.Sheets(3).Select
    ActiveSheet.PrintOut Copies:=1
End Sub

di patel data: 18/05/2016 12:29:56
vista la disponibilità ad allegare elimino il codice proposto
di Peppe (utente non iscritto) data: 18/05/2016 16:20:57
Purtroppo le macro non funzionano. Quelle indicate da Alfarimpa causano il blocco completo di Excel (Excel ha smesso di funzionare).La macro di Patel non parte a causa di un errore "Indice non compreso nell'intervallo".
di patel data: 18/05/2016 16:30:07
e il file di esempio ?
di alfrimpa data: 18/05/2016 16:30:37
Ma hai provato la macro ProvaStampa su un unico file?

Alfredo
di Peppe (utente non iscritto) data: 18/05/2016 17:19:42
La macro su unico foglio funziona, se la copio nel foglio; ma non è quello che cercavo, a me serviva una macro che stampasse i fogli indicati senza aprire il file, anche perché i file sono in realtà oltre 500 e volevo automatizzare il processo di stampa. Non so cosa potrei allegare: posso allegare tre file qualsiasi, dei quali voglio stampare i fogli, poniamo, 2, 4 e 5, ma non so che utilità potrebbe avere.

di Albatros54 data: 18/05/2016 18:22:20
Se ho capito.
Ho supposto che i file da cui tu vuoi stampare i fogli si trovano in questo
path "C:UsersUtenteDesktopdatabasecartella".
in un file di excel che si trova al di fuori di questo Path incolla il codice sotto in un modulo è lo esegui.
Fai sapere
ciao
albatros54

Public Sub stampa()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim n As Long

    With Application
        .ScreenUpdating = False
    End With
    sPath = "C:UsersUtenteDesktopdatabasecartella" '<< da Modificare
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        Set wk = Workbooks.Open(objFile.Path)

        fogli = Split(InputBox("Fogli da stampare (numeri separati da virgole"), ",")
        For n = 0 To UBound(fogli)
            Sheets(Val(fogli(n))).PrintOut
        Next
        wk.Close
        Set wk = Nothing
    Next
    With Application
        .ScreenUpdating = True
    End With
    Set wk = Nothing
    Set sh = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

End Sub

di Peppe (utente non iscritto) data: 18/05/2016 20:18:47
Grazie Albatros54, appena posso provo. Segnalo, però, come ulteriore difficoltà, il fatto che i file Excel di cui voglio stampare alcuni fogli si trovano su una USB, che non è identificata sempre dalla stessa lettera (varia la lettera a secondo del PC in cui la inserisco).
di peppe (utente non iscritto) data: 19/05/2016 09:41:56
Ciao Albatros

Ho provato, ma la macro manda in crash Excel.
di Albatros54 data: 19/05/2016 09:50:50
prova ad inserire un numero di file excel minore , tipo 10, nella dir cartella è prova.
albatros54
di Peppe (utente non iscritto) data: 19/05/2016 09:56:13
Già l'ho fatto, ne ho messi solo tre.
di Albatros54 data: 19/05/2016 09:59:53
prova a fare girare la macro con Excel2007, se ne hai la possibilita,perchè questa macro è stata testata piu' volte è funziona bene.
ps. il file da cui lanci la macro si trova fuori dalla dir cartella, naturalmente!
albatros54
di Peppe (utente non iscritto) data: 19/05/2016 10:55:15
Non ho Excel 2007. Il file con la macro si trova sul Desktop, ma non nella cartella dove si trovano i tre file da stampare. Posso provare anche a spostarlo dal Desktop, mettendolo in Documenti. Ad ogni buon conto, ti allego il file con la macro, non vorrei avere fatto io qualche errore nell'adattarlo al mio percorso...

di Albatros54 data: 19/05/2016 11:02:55
non devi modificare la macro.
devi modificare solo il path.
I numeri di pagina li devi inserire dentro la Inputbox quando te lo chiede
per non sbagliare sul path , vai sulla cartella "gvitiello01" che si trova sul desktop, tasto destro del mouse proprieta, è vedi il path, lo prendi è lo copi, aggiungenro il nome della cartella con le "".

fogli = Split(InputBox("1", "2", "3", "4", "5", "6")) NOOO!!
fogli = Split(InputBox("Fogli da stampare (numeri separati da virgole"), ",")SIII!

 sPath = "C:usersutentedesktopgvitiello01cartella" manca la

di Peppe (utente non iscritto) data: 19/05/2016 13:01:35
Ho fatto come dici, ma Excel mi va in crash lo stesso. Ecco il dettaglio:

Firma problema:
Nome evento problema: APPCRASH
Nome applicazione: EXCEL.EXE
Versione applicazione: 14.0.7168.5000
Timestamp applicazione: 56eade71
Nome modulo con errori: EXCEL.EXE
Versione modulo con errori: 14.0.7168.5000
Timestamp modulo con errori: 56eade71
Codice eccezione: c0000005
Offset eccezione: 004ef40d
Versione SO: 6.1.7601.2.1.0.256.4
ID impostazioni locali: 1040

Ulteriori informazioni sul problema:
LCID: 1040
skulcid: 1040

di Raffaele_53 data: 19/05/2016 20:19:17
Non riesco capire l'utilita del VBA, stampare diversi fogli per 500 file. Una volta fatto cosa possa servire in futuro?
Inoltre il problema della USB. Questo codice stampa tutto quello presente nella medesima cartella dove è posizionato il file.
Comunque per prova avvia stampa1
Se funziona prova stampa2, a riguardo eventuali errori, i casi che mi vengono in mente sono tre:
1) Esiste un file rovinato
2) Nel file manca uno dei vari fogli
3) Nella cartella esistono file diversi da Excel (word,pdf,ecc)

EDIT Per sicurezza metti >>>nomeFile = Dir(Percorso & "*.xls*")

Ps. Sei sicuro che i fogli nei file si chiamano tutti allo stesso modo?
Foglio1,Foglio2,Foglio3,Foglio4 ecc ecc

Option Explicit
Sub stampa1()
Sheets(Array("Foglio1")).PrintOut
End Sub
Sub stampa2()
    Dim Percorso As String, nomeFile As String
    Percorso = ThisWorkbook.Path & ""
    Application.ScreenUpdating = False
    nomeFile = Dir(Percorso & "*.xls*")
    Do While nomeFile <> ""
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Percorso & nomeFile)
            Sheets(Array("Foglio1")).PrintOut 
            Workbooks(nomeFile).Close False
' se funziona prova Sheets(Array("Foglio1","Foglio2",ecc,ecc,ecc)).PrintOut
        End If
        nomeFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fatto"
End Sub

di Peppe (utente non iscritto) data: 19/05/2016 23:06:37
L'utilità del file sta nel fatto che ho necessità di archiviare in formato cartaceo alcuni dati presenti in alcuni fogli di questi 500 file di excel. Se ho ben capito devo copiare la macro stampa1 in un foglio vuoto, che metto nella stessa cartella dove si trovano i file di excel, ed avviarla. Se funziona devo copiare la macro stampa2, che è quella che dovrebbe stampare il foglio1 dei vari file; e se funziona anche questa fare eseguire la macro stampa2 modificata in modo da stampare anche gli altri fogli. Domattina provo e ti faccio sapere. Intanto ti ringrazio.
di Peppe (utente non iscritto) data: 20/05/2016 09:45:04
Grazie Raffaele, ho provato e mi sembra che funzioni molto bene!! Resta tuttavia un dettaglio da mettere a punto: ogni foglio che stampo consta di più pagine (in genere 7-8), io avrei la necessità invece di stampare solo la prima, oppure la prima e la seconda pagina. E' possibile nella macro andare a specificare quali pagine stampare di ciascun foglio? Preciso che le pagine da stampare sono sempre le stesse per tutti i fogli che vado a stampare: ad esempio, stampare le pagine 1 e 2 del Foglio1, la pagina 1 del Foglio2, la pagina 1 del foglio3, e così via. Grazie.

di Raffaele_53 data: 20/05/2016 12:29:32
Dovrebbe essere cosi.
Per evitare casomai che un nome foglio sia differente, potresti anche provare la riga verde.
Ps. ex Inputbox digitare 2-4
Pps per una pagina sola 2-2

Sub stampa3()
    Dim Percorso As String, nomeFile As String, v1, v2, v3 As String
    Percorso = ThisWorkbook.Path & ""
    v3 = InputBox(" Inserire n° iniziale di pagina e n° finale di pagina [ex 1 TRATTINO 3]=1-4 oppure 2-3, 3-4", , "-")
    If v3 <> "-" And InStr(v3, "-") > 1 Then
    v1 = CInt(Mid(v3, 1, InStr(v3, "-") - 1))
    v2 = CInt(Mid(v3, InStr(v3, "-") + 1, 100))
    Application.ScreenUpdating = False
    nomeFile = Dir(Percorso & "*.xls*")
    Do While nomeFile <> ""
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Percorso & nomeFile)
            Sheets(Array("Foglio1", "Foglio3")).PrintOut From:=v1, To:=v2, Copies:=1
            'Sheets(Array(Sheets(1).Name, Sheets(2).Name)).PrintOut From:=v1, To:=v2, Copies:=1
            Workbooks(nomeFile).Close False
        End If
        nomeFile = Dir
    Loop
    MsgBox "Fatto"
    End If
    Application.ScreenUpdating = True
End Sub

di Peppe (utente non iscritto) data: 20/05/2016 14:36:52
La macro mi manda in crash Excel, ma forse sono io che ho sbagliato qualcosa. Cosa stanno ad indicare v1, v2 e v3?
Non ho capito l'istruzione per v3: va bene se inserisco 1-2, per indicare che devono essere stampate le pagine 1 e 2?.
L'istruzione alla riga verde deve essere inserita nella macro o no?. Grazie.
di Raffaele_53 data: 20/05/2016 15:23:08
v3 = i dati che digiti nell'inputbox (ex se digiti 1-2)
v1 Prende il dato prima del "-" =1
v2 Prende il dato prima dopo il "-" =2
La riga verde rimane disabilitata finchè non togli il ' iniziale, naturalmente alla riga precedente dovrai mettere 'iniziale

Fai una prova su un file da stampare, avvia il registratore di macro.
Clicca sulla linguetta del foglio1, premi CTRL e premi sulla linguetta del foglio3 e premi stampa (tra le varie opzioni di stampa ci dovrebbe essere "tutto o pagine", spunta la scelta Pagine e metti 1 iniziale e 3 finale) dai OK. Ferma il registratore e allega il codice che ha creato.
di Peppe (utente non iscritto) data: 20/05/2016 20:04:19
Non so, ma premendo con il tasto destro sull'etichetta del foglio3, dopo aver fatto CTRL sull'etichetta del foglio1, compare un menu nel quale non c'è l'opzione stampa.
di Raffaele_53 data: 21/05/2016 03:27:11
>>>il tasto destro sull'etichetta
Non ho scritto usare tasto destro, usa il sinistro per foglio1 premi CTRL e premi ancora col sinistro su foglio3. Vai in alto Icona d'excel digli stampa sclegiendo pagine 1= inizio e 2= fine.

Suggerisco inoltre di mettere sotto la riga verde un nuova riga e scrivere
DoEvents
Tale comando da il tempo a Windows d'eseguire
di Peppe (utente non iscritto) data: 21/05/2016 11:47:36
Ho fatto, ed ho ottenuto questo codice:

Sheets("Foglio1").Select
Sheets("Foglio1").Name = "Foglio1"
Sheets("Foglio3").Select
Sheets("Foglio3").Name = "Foglio3"

Stavo riflettendo sulla tua macro. Se la modificassi come segue pensi che potrebbe funzionare?.
Option Explicit
Sub stampa2()
Dim Percorso As String, nomeFile As String
Percorso = ThisWorkbook.Path & ""
Application.ScreenUpdating = False
nomeFile = Dir(Percorso & "*.xlsm*")
Do While nomeFile <> ""
If nomeFile <> ThisWorkbook.Name Then
Workbooks.Open (Percorso & nomeFile)
Sheets(Array("Foglio1")).PrintOut From =1, To=2
Sheets(Array("Foglio2")).PrintOut From =1 To=1
Sheets(Array("Foglio5")).PrintOut From =2, To =2
Workbooks(nomeFile).Close False
DoEvents
End If
nomeFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Fatto"
End Sub
di Raffaele_53 data: 21/05/2016 12:51:37
Tre errori:
>>>nomeFile = Dir(Percorso & "*.xlsm*")
La "m" finale, significa che stamperai tutti i file con Macro e non servirebbe "*". Se desideri i files senza macro sarebbe così & "*.xlsx", mà non sapendo quali estenzioni hai (ex se precedenti a 2007 ), nel codice ho messo & "*.xls*"

>>>Sheets(Array....
Serve per stampare diversi fogli in un colpo solo. Noto che stampi Pagine diverse per ogni foglio, comunque dovrebbe funzionare
Sheets("Foglio1").PrintOut From =1, To=2
Sheets("Foglio2").PrintOut From =1 To=1
Sheets("Foglio5").PrintOut From =2, To =2

>>>DoEvents .....
Questa riga va messa prima di Workbooks(nomeFile).Close False
di Peppe (utente non iscritto) data: 21/05/2016 15:32:46
Grazie per i preziosi suggerimenti..faccio le modifiche che mi hai detto, provo e poi ti dico.

di Peppe (utente non iscritto) data: 23/05/2016 09:27:07
Non riesco proprio a capire dov'è l'errore, la macro non gira e fa bloccare Excel. Ho sostituito a Foglio1, Foglio2, etc, il nome esatto del foglio, ma non penso che sia questo il problema, visto che in tutti i file i fogli hanno i medesimi nomi.

Sub stampa()
    Dim Percorso As String, nomeFile As String
    Percorso = ThisWorkbook.Path & ""
    Application.ScreenUpdating = False
    nomeFile = Dir(Percorso & "*.xls*")
    Do While nomeFile <> ""
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Percorso & nomeFile)
            Sheets(Array("Anagrafica")).PrintOut From:=1, To:=1
            Sheets(Array("Mansione")).PrintOut From:=1, To:=1
            Sheets(Array("Visita2016")).PrintOut From:=1, To:=2
            Sheets(Array("VDT")).PrintOut From:=1, To:=2
            DoEvents
            Workbooks(nomeFile).Close False
            End If
            nomeFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fatto"
End Sub

di Raffaele_53 data: 23/05/2016 13:41:58
Eppur è stato scritto
>>>Ps. Sei sicuro che i fogli nei file si chiamano tutti allo stesso modo?Foglio1, Foglio2, Foglio3, Foglio4 ecc ecc

>>>Sheets(Array....Serve per stampare diversi fogli in un colpo solo. Noto che stampi Pagine diverse per ogni foglio, comunque dovrebbe funzionare
Ex Sheets("Anagrafica").PrintOut From:=1, To:=1 ecc ecc

Allega un file che dovresti stampare (casomai elimina dati sensibili)
di Peppe (utente non iscritto) data: 23/05/2016 15:37:07
Allego due file che dovrei stampare; i file si trovano in una cartella (sono 500 file circa), di ognuno vorrei stampare solo alcuni fogli, e di ciascun foglio solo alcune pagine. Tutti i fogli hanno lo stesso numero di fogli, ed i nomi dei fogli sono esattamente corrispondenti in tutti file; anche le pagine da stampare per ciascun foglio sono uguali in tutti i file.

di Raffaele_53 data: 23/05/2016 16:32:09
Per caso hai un file "madre" che genera questi fogli?
Casomai allegalo "originale"

Con quei due file non posso farci nulla, se Vuoi prova zipparli
Perchè a me in Formule/Gestione nomi vedo una miriade di collegamenti con #RIF errati ed appena n'è apro uno si blocca perchè i riferimenti sono mancanti. Devi correggerli (mi sa che hai copiato fogli originali sul file che facevi prove ed i collegamenti sono rimasti sul Tuo PC)

Vedo anche 6 bottoni in anagrafica, che cosa dovrebbero fare?
Vedo anche alla fine dei fogli, Foglio1:Foglio10 vuoti, cosa servono?

NB. Se ti posizioni col mouse dentro il codice, premi F8 noterai una riga gialla, ripremi F8 avanza la riga e continua finchè non Ti da errore. Almeno sappiamo qual'è?

Sub stampa()
    Dim Percorso As String, nomeFile As String
    Percorso = ThisWorkbook.Path & ""
    Application.ScreenUpdating = False
    nomeFile = Dir(Percorso & "*.xlsm")
    Do While nomeFile <> ""
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Percorso & nomeFile)
            Sheets("Anagrafica").PrintOut From:=1, To:=1
            Sheets("Mansione").PrintOut From:=1, To:=1
            Sheets("Visita2016").PrintOut From:=1, To:=2
            Sheets("VDT").PrintOut From:=1, To:=2
            DoEvents
            Workbooks(nomeFile).Close False
            End If
            nomeFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fatto"
End Sub

di Peppe (utente non iscritto) data: 24/05/2016 09:12:03
Ho allegato il file completo (Originale), con tutte le macro attive. Tutti i file presenti nella cartella hanno la stessa struttura, con lo stesso nome dei fogli.

di Raffaele_53 data: 24/05/2016 14:27:44
Faccio una premessa (non sò se sarò in grado)
Di sicuro non mi basta che alleghi un file senza spiegare nulla, inoltre se Ti vengono fatte domande, il minimo sarebbe rispondere alle stesse.

Comunque fai una Prova (a me funziona), crea una nuova cartella. Inserisci all'interno il file "Originale", vai in foglio Dati e in B1 e modifica in =Anagrafica!B15&" "&Anagrafica!F15
Salva il file, usa il codice sotto per salvare 4/5 finti pazienti
Alla fine usa l'ultimo Sub stampa() e prova stampare.
Ps. Per forza devono essere salvati come XLSM?

Sub salvaXlSM()
Dim Percorso, X, nome
Percorso = ThisWorkbook.Path & ""
Workbook.SaveAs FileName:=Percorso & Range("Dati!b1").Value & ".xlsm"
For X = 1 To Sheets.Count
nome = Sheets(X).Name
Sheets(nome).Visible = True
Next
ThisWorkbook.Close SavecHANGES:=True
Application.Quit
End Sub

di Peppe (utente non iscritto) data: 24/05/2016 17:01:58
Scusa Raffaele, ma non riesco a comprendere le tue istruzioni; evidentemente non sono stato capace di spiegare il mio problema. Il file che ho allegato, denominato "Originale" è il file modello, con il quale ho compilato circa 500 schede di visita (ogni visita è un file). I 500 file sono attualmente in cartelle diverse, ma posso riunirli in un'unica cartella. Ogni file si riferisce a visite fatte nel corso degli anni (una all'anno): per evitare di avere troppe etichette nascondo i fogli relativi ai prossimi anni, in modo da vedere solo l'etichetta del foglio dell'anno in corso; per fare questo mi servo di pulsanti posizionati nel foglio "Anagrafica". Tutti i file sono salvati con xlsm in quanto presentano numerose delle macro, che mi servono per automatizzare vari processi: per avviare tali macro ho sistemato dei pulsanti sui fogli "Visita", "VDT" e "Visite oculistiche". Ad esempio, il pulsante Stampa visita e questionari mi stampa il foglio "Visita" (dell'anno di riferimento), il foglio mansione, ed i questionari (che sono rappresentati dai fogli OA,VDT e Visite oculistiche). Il pulsante salva con nome mi salva il file automaticamente nella cartella prestabilita (la macro legge il nome di tale cartella da un collegamento che ho inserito nel foglio dati con il foglio Anagrafica: a secondo della sede di lavoro il file viene salvato nella cartella corrispondente), mentre la macro salva con nome e stampa certificato fa esattamente questo, salva il file con nome e stampa il certificato. Ora mi trovo a dovere stampare alcuni fogli di tutti i file, per esigenze di archiviazione cartacea. Anzicchè aprire uno ad uno i 500 file e stampare i fogli che mi occorrono (Anagrafica, Mansione, Visita2016, VDT, Visite oculistiche) mi serviva una macro che facesse proprio questo: aprire e stampare la prima pagina (oppure la prima e seconda pagina) di tali fogli di tutti i file.
Mi avevi qualche giorno fa inviato una macro, che avevo provato e funzionava bene:
Sub stampa2()
Dim Percorso As String, nomeFile As String
Percorso = ThisWorkbook.Path & ""
Application.ScreenUpdating = False
nomeFile = Dir(Percorso & "*.xls*")
Do While nomeFile <> ""
If nomeFile <> ThisWorkbook.Name Then
Workbooks.Open (Percorso & nomeFile)
Sheets(Array("Foglio1","Foglio2","Foglio3",Foglio4")).PrintOut
Workbooks(nomeFile).Close False
nomeFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Fatto"
End Sub

Il problema è che la macro stampa tutte le pagine dei fogli indicati, mentre a me serve solo la prima pagina, oppure la prima e la seconda pagina; mi chiedevo se fosse possibile evitare lo spreco di carta ed inchiostro e stampare solo la prima pagina (oppure la prima e la seconda pagina) dei file indicati.
Tu mi scrivi di modificare il contenuto della cella B1 nel foglio Dati; ma si tratta di oltre 500 file!! Devo modificarli tutti?? "Alla fine usa l'ultimo sub stampa() e prova a stampare": dove sta questo sub stampa()??
Scusa, ma mi sto perdendo, e penso che dovrò rassegnarmi!!!
di Raffaele_53 data: 24/05/2016 18:35:55
Ho l'impressione che non desideri leggere
>>>dove sta questo sub stampa()??
Dove sta??? In base alla data del post: di Raffaele_53 (Utente esperto) data: 23/05/2016 16:32:09

Allegato Raffaele.xlsm
Decomprimi il file sul desktop, ti ritroverai una cartella = raffaele
Dentro tre file, avvia Ospedale, vai su "Anagrafica" e metti in D15 cognome fasullo e in F15 nome fasullo, basta. Premi il bottone salva. Excel si chiude riaprilo e fallo per altre 2/3 volte.
Per provare premi "STAMPA" e dimmi se funziona

NB. il problema di stampa deriva dai fogli nascosti e dal collegamento cella B1 di "Dati" (se non erro)

di Albatros54 data: 25/05/2016 12:34:25
Scusate se ritorno a intromettermi nella discussione.
Ho creato una cartella sul Desktop dal nome "Database", dentro questa cartella ho creto un file excel "stampa"
ho aperto VBA è ho inserito un modulo,in questo modulo ho incollato il codice che posto.
Poi dentro la cartella "database" ho creato un'altra cartella chiamandola "cartella", dentro questa cartella ho inserito il file "originale.xlsm".
A questo punto, non aprendo il file "originale",sono andato nella cartella "database",ho paeto il file "stampa" è ho lancia la macro creata in precedenza, il tutto funziona, con excel2007.

Public Sub stampa()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim n As Long

    With Application
        .ScreenUpdating = False
    End With
    sPath = "C:UsersUtenteDesktopdatabasecartella" '<< da Modificare
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
    Select Case LCase(Right(objFile.Name, 4))
            Case ".xls", "xlsx", "xlsm"
        Set wk = Workbooks.Open(objFile.Path)

        fogli = Split(InputBox("Fogli da stampare (numeri separati da virgole"), ",")
        da = Split(InputBox("Stampa da pagina (numeri separati da virgole"), ",")
        a = Split(InputBox("A pagina (numeri separati da virgole"), ",")
        For n = 0 To UBound(fogli)
            Sheets(fogli(n)).PrintOut From:=da, To:=a
        Next
        wk.Close
        Set wk = Nothing
           End Select
    Next
    With Application
        .ScreenUpdating = True
    End With
    Set wk = Nothing
    Set sh = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

End Sub

di Raffaele_53 data: 25/05/2016 12:49:11
@Albatros54
Tutto OK e grazie dell'aiuto, però l'utente non è molto pratico.
Ps. Non desidera stampare le stesse pagine per ogni foglio ("da" e "a")

di Peppe (utente non iscritto) data: 26/05/2016 15:43:45
Scusate il ritardo nella risposta, ma sono stato in viaggio senza PC. Ho scaricato il file di Raffaele, e funziona molto bene!!! Come faccio, ora, ad applicare la soluzione alle mie esigenze??
La soluzione di Albatros non funziona, ma forse sono io che sbaglio; ho infatti adattato la sua macro, come segue, ma mi manda in crash Excel.

Select Case LCase(Right(objFile.Name, 4))
            Case ".xls", "xlsx", "xlsm"
        Set wk = Workbooks.Open(objFile.Path)

        fogli = Split(InputBox("1","2","3"))
        da = Split(InputBox("1"))
        a = Split(InputBox("2"))
        For n = 0 To UBound(fogli)
            Sheets(fogli(n)).PrintOut From:=da, To:=a
        Next
        wk.Close
        Set wk = Nothing
           End Select

di Raffaele_53 data: 26/05/2016 16:31:01
Per quanto riguarda la mia risposta.
Si potrebbe creare un VBA da fare girare (una volta solo) nella/nelle cartella dei 500 file
Che apra/visualizzi tutti i fogli e modifica la formula in B1 di "Dati".
Dopo Excel non dovrebbe più andare in crash. Se Ti va bene la faccio.
di Peppe (utente non iscritto) data: 26/05/2016 16:54:12
Grazie Raffaele, la tua soluzione mi sembra che vada bene!!
di Albatros54 data: 26/05/2016 17:12:33
@PEPPE
perche modifichi il CODICE!!!!
i valori che dai alle variabili "fogli" "da" "a", li devi prendere dalle inputbox, non modificando il codice, l'unica maodifica che DEVI apportare al codice è il path.

di Raffaele_53 data: 26/05/2016 18:20:55
@Albatros54
Scusami, i file non si chiamano 1,2,3
Inoltre per ogni file desidera pagine differenti per ogni foglio.
Inoltre se il foglio è nascosto il codice va in errore

@Peppe
Elimina dalla cartella Raffaele tutti i file tranne Ospedale
Copia nella cartella Raffaele un decina dei file tuoi
Inserisci in Ospedale.xlsm il codice sotto. Avvialo
Una volta fatto premi il bottone Stampa

Sub Apri_fogli_Mod_Formula()
Dim Percorso, X, nome, nomeFile
Percorso = ThisWorkbook.Path & ""
Dim WB As Workbook
    Application.ScreenUpdating = False
    nomeFile = Dir(Percorso)
    Do While nomeFile <> ""
        If nomeFile <> ThisWorkbook.Name Then
            Workbooks.Open (Percorso & "" & nomeFile)
            For X = 1 To Sheets.Count
                nome = Sheets(X).Name
                Sheets(nome).Visible = True
            Next
            Workbooks(nomeFile).Sheets("Dati").Range("B1").FormulaR1C1 = "=Anagrafica!R[14]C&"" ""&Anagrafica!R[14]C[4]"
            Workbooks(nomeFile).Close SavecHANGES:=True
        End If
        nomeFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fatto"
End Sub

di Peppe (utente non iscritto) data: 30/05/2016 09:45:35
Grazie Raffaele, mi sembra che funzioni tutto benissimo!!!

Vuoi Approfondire?