Screenshot automatizzato fogli excel:script?macro o...?

[Paolo67met]

Ciao a tutti,
faccio la seguente richiesta sperando che il topic sia nella giusta sezione.
Ho una cartella di lavoro con n-fogli.
Vorrei poter fare uno screenshot di tutti gli n-fogli e metterli in una cartella x (premendo un pulsante...lanciando uno script...non saprei).
E' possibile o sto chiedendo la luna?
Grazie

[Anthony47]

Ma ti serve veramente un jpg del singolo foglio? Non ti puo' bastare fare una stampa pdf del tutto?
Esempio:
-Selezioni il primo foglio (il tab piu' a sinistra), con MAIUSC premuto selezioni l'ultimo Tab
-opzionalmente selezioni l'area che vuoi gestire (sara' la stessa su tutti i fogli)
-avvii la stampa; come stampante scegli "Microsoft print to Pdf"
-se hai selezionato una area scegli "Stampa Selezione", altrimenti "Stampa Fogli attivi"
-siccome stai avviando una "stampa" puoi impostare anche una "scala", esempio "adatta foglio su 1 pagina" (la stampa di ogni foglio occuperà 1 pagina): e altre impostazioni tipiche di una stampa
-premi Stampa e ti verrà chiesto nome file e posizione di salvataggio

Se la cosa e' da fare spesso puoi registrare una macro mentre esegui le operazioni.

Se invece vuoi proprio creare delle immagini jpg il processo sarà un po più complesso, ma si puo' fare; dovresti però spiegare quale area del foglio catturare
Indica pure la versione Excel in uso

[Paolo67met]

Ciao Anthony,
allora la versione di Excel è la 2007.
No devo proprio creare delle immagini jpg di ogni foglio.
Ovviamente dovrei catturare quello che vedo nello schermo e non quello che è in altra zona dello stesso foglio (dove ci possono essere le elaborazioni dei dati).
L'ideale sarebbe specificare dalla cella x alla y ti faccio un esempio nella figura sotto.
Prendiamo a caso il foglio Lowlevel,dovrei poter catturare tutto quello che vedo a schermo dalla cella A1 alla R26 (in questo caso).



Ma ci potrebbe essere anche qualche foglio dove le celle da catturare vanno da A1 a V41 come quest'altra immagine.



Questo per darti un'idea (non so se si può adoperare però questo modo di "aquisizione"
Spero di essere stato chiaro.
Intanto ti ringrazio

[Dylan666]

Molte stampanti virtuali oltre che in PDF stampano anche in JPG o PNG.
Potresti provare con quelle, eccone qualcuna (vado a memoria):

https://github.com/clawsoftware/clawPDF

https://www.bullzip.com/products/pdf/info.php#download

https://www.pdfforge.org/pdfcreator

[Anthony47]

Vedi il messaggio di Dylan, sopra

In alternativa possiamo usare questa macro:

Codice: Seleziona tutto

Sub MakeImgs()
Dim I As Long, picRange As Range
Dim DPath As String, Result As String

'DPath = "c:\prova"                  '<<< La directory di salvataggio
For I = 1 To Worksheets.Count
    Sheets(I).Select
    Set picRange = Application.Intersect(ActiveWindow.VisibleRange, ActiveSheet.UsedRange)
    Result = CopyRangeToJPG(picRange, "RTP_" & ActiveSheet.Name, DPath)
    Debug.Print I, picRange.Address(0, 0), Result
Next I
Msgbox("Completato...")
End Sub


La riga marcata <<< deve essere compilata con un percorso (esistente) in cui verranno salvati i file ipg creati; se omessa (o impostata su "") verrà usata la directory Temp dell'utente
Il nome delle immagini sara' pari al nome del foglio; eventuali immagini con lo stesso nome gia' presenti nella directory verranno cancellate senza preavviso
L'area dell'immagine sarà data dall'intersezione tra l'area visualizzata a schermo e l'area utilizzata dal singolo foglio.
Un msgbox avvertirà del completamento delle operazioni

La macro e' relativamente semplice perchè si appoggia su quest'altra macro per generare l'immagine dato il range, anch'essa da copiare sul tuo modulo vba:

Codice: Seleziona tutto

Function CopyRangeToJPG(ByRef myRan As Range, _
 Optional ImgName As String = "NewPicName", _
 Optional ByVal pPath As String = "") As String
 '
Dim PictureRange As Range
Dim PicName As String
Dim cPos As Range, Extn As String
'

ImgName = ImgName & ".jpg"
If pPath = "" Then
    pPath = Environ$("temp") & Application.PathSeparator
Else
    If Right(pPath, 1) <> Application.PathSeparator Then
        pPath = pPath & Application.PathSeparator
    End If
End If
'
On Error Resume Next
    Kill pPath & ImgName
On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:01"))
'
Application.ScreenUpdating = False
Set cPos = ActiveWindow.RangeSelection
    With ActiveWorkbook
        On Error Resume Next
        Application.Goto myRan.Cells(1, 1), scroll:=True
        Set PictureRange = myRan
        If PictureRange Is Nothing Then
            CopyRangeToJPG = ""         'Se immagine non creata, restituisce stringa Nulla
            Exit Function
        End If
        '
        PictureRange.CopyPicture
        With ActiveSheet.ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export pPath & ImgName, "JPG"
        End With
        ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
    End With
    CopyRangeToJPG = pPath & ImgName
    Set PictureRange = Nothing
    Application.Goto cPos
Application.ScreenUpdating = True
DoEvents
End Function


Prova...

[Paolo67met]

Allora Anthony ho scritto le 2 macro nel modulo VBA.
Funziona!!
Però c'è un problemino:
Se immetto come path:
"E:\Meteorologia\Software meteo\Wetbulb in quota\Screenshot"
oppue il tuo:
"C:\prova"
ossia la directory di salvataggio,le immagini vengono cmq sempre e solo copiate nella cartella Temp:
C:\Utenti\Paolo\AppData\Local\Temp
quindi come se immettessi un Path sbagliato.

@Dylan666 grazie anche per le tue soluzioni. Tuttavia quella propostami da Anhony mirisulta più immediata

[Anthony47]

Ripeto che la directory che indichi deve gia' essere presente sul disco; comunque non mi torna il comportamento che dici...

Chiudi Excel; riaprilo, ricarica il file ed esegui la Sub MakeImgs
Alla fine apri il vba, apri la "finestra Immediata" (dovrebbe bastare digitare Contr-g; oppure Menu /Visualizza /finestra Immediata); copia quello che c'e' scritto dentro e pubblicalo nel prossimo messaggio.

[Paolo67met]

La directory è già presente!
Questo è quello nella finestra immediata

1 A1:W39 C:\Users\Paolo\AppData\Local\Temp\RTP_PulsantiGFS.jpg
2 A1:W39 C:\Users\Paolo\AppData\Local\Temp\RTP_PulsantiAnalisi.jpg
3 BR1:BW34 C:\Users\Paolo\AppData\Local\Temp\RTP_Verifiche.jpg
4 F1:W25 C:\Users\Paolo\AppData\Local\Temp\RTP_Input.jpg
5 BO1:CI29 C:\Users\Paolo\AppData\Local\Temp\RTP_RS.jpg
6 A55:X90 C:\Users\Paolo\AppData\Local\Temp\RTP_RUN.jpg
7 A32:V63 C:\Users\Paolo\AppData\Local\Temp\RTP_OsservazioniGFS.jpg
8 A1:T22 C:\Users\Paolo\AppData\Local\Temp\RTP_RiepilogoGFS.jpg
9 A1:N42 C:\Users\Paolo\AppData\Local\Temp\RTP_SpestestGFS.jpg
10 A1:R35 C:\Users\Paolo\AppData\Local\Temp\RTP_TempcamicciGFS.jpg
11 A1:Q35 C:\Users\Paolo\AppData\Local\Temp\RTP_Wetbulb850GFS.jpg
12 A1:Q35 C:\Users\Paolo\AppData\Local\Temp\RTP_Temp850GFS.jpg
13 A1:Q35 C:\Users\Paolo\AppData\Local\Temp\RTP_ZerowetbulbGFS.jpg
14 A1:Q35 C:\Users\Paolo\AppData\Local\Temp\RTP_ZerotermicoGFS.jpg
15 A1:Y50 C:\Users\Paolo\AppData\Local\Temp\RTP_SpessoriGFS.jpg
16 A1:Z46 C:\Users\Paolo\AppData\Local\Temp\RTP_NowGFS.jpg
17 A1:N45 C:\Users\Paolo\AppData\Local\Temp\RTP_EnsembleGFSforecast.jpg
18 A1:K38 C:\Users\Paolo\AppData\Local\Temp\RTP_FinalGFSforecast.jpg
19 A1:K38 C:\Users\Paolo\AppData\Local\Temp\RTP_Rain&twbGFS.jpg
20 BY1:CM33 C:\Users\Paolo\AppData\Local\Temp\RTP_NowcastingGFS.jpg
21 A1:J38 C:\Users\Paolo\AppData\Local\Temp\RTP_OutlookGFS.jpg
22 A1:T34 C:\Users\Paolo\AppData\Local\Temp\RTP_GraficiGFS.jpg
23 A1:AE42 C:\Users\Paolo\AppData\Local\Temp\RTP_Pubblico.jpg
24 A1:AH41 C:\Users\Paolo\AppData\Local\Temp\RTP_Algoritmi.jpg
25 A1:S26 C:\Users\Paolo\AppData\Local\Temp\RTP_ooy.jpg
26 A1:I20 C:\Users\Paolo\AppData\Local\Temp\RTP_Riepilogo.jpg
27 A1:AF46 C:\Users\Paolo\AppData\Local\Temp\RTP_Quote.jpg
28 A1:R22 C:\Users\Paolo\AppData\Local\Temp\RTP_Wetbulb.jpg
29 A1:R16 C:\Users\Paolo\AppData\Local\Temp\RTP_Temperatura.jpg
30 A1:Q16 C:\Users\Paolo\AppData\Local\Temp\RTP_Dew.jpg
31 A1:Q18 C:\Users\Paolo\AppData\Local\Temp\RTP_Umidità.jpg
32 A1:V42 C:\Users\Paolo\AppData\Local\Temp\RTP_T&U.jpg
33 A1:T30 C:\Users\Paolo\AppData\Local\Temp\RTP_Tabellastazioni.jpg
34 AH1:AY41 C:\Users\Paolo\AppData\Local\Temp\RTP_Calcoli.jpg
35 A11:G44 C:\Users\Paolo\AppData\Local\Temp\RTP_Osservazioni.jpg
36 A1:L34 C:\Users\Paolo\AppData\Local\Temp\RTP_Disagio.jpg

E questo il contenuto nella finestra makeimages

[Anthony47]

C'e' un equivoco di fondo...
La riga DPath = etc etc (come qualsiasi altra riga) se e' preceduta da un Apostrofo allora e' considerata un commento, non una istruzione
Pertanto nella tua macro DPath non e' impostata e viene usata la Temp

Togli l'apostrofo e ti troverai (spero) bene

[Paolo67met]

Funge alla perfezione!
Grande!!