| | Post: 1 | Registrato il: 14/01/2022
| Età: 31 | Utente Junior | 2016 | | OFFLINE | |
|
  14/01/2022 12:10 | |
Buongiorno a tutti 😊
Sono nuovo e non so se è giusto creare una discussione per la mia domanda.
Comunque, per il mio lavoro mi sarebbe molto comodo avere una macro che crei in automatico un'istantanea di un'area specifica del foglio e che venga poi salvata nel dekstop (per esempio).
Potete aiutarmi? 😀
Grazie,
Luca |
|
| | Post: 3.264 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
| 14/01/2022 12:37 | |
Ciao
un modo potrebbe essere il seguente che salva il range indicato come immagine jpg....qualora servisse puoi effettuare il salvataggio come pdf, vedi tu.
saluti
Sub SalvamImageFoglio()
Dim wsSheet As Worksheet, oRange As Range, oCht As Chart, oImg As Picture
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set oRange = Range("A1:E30") '<<<< range da salvare VARIARE
Set oCht = Charts.Add
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
filepath = "c:\miacartella\" 'dove salvare l'immagime <<<< VARIARE
ActiveSheet.Export Filename:=filepath & "MyPic.jpg", FilterName:="jpg" '<<<< VARIARE NOME
ActiveSheet.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "creato file"
End SubDomenico
Win 10 - Excel 2016 |
| | Post: 1 | Registrato il: 14/01/2022
| Età: 31 | Utente Junior | 2016 | | OFFLINE | |
|
| 14/01/2022 15:03 | |
Ti ringrazio per la risposta tempestiva.
Ho provato ad usarla modificando le parti di mio interesse.
Come macro non da errore e la esegue: il problema è che l'immagine è completamente bianca 😅
Ho riprodotto qua sotto la macro:
Sub SalvaImmaginediFoglio()
Dim wsSheet As Worksheet, oRange As Range, oCht As Chart, oImg As Picture
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = Worksheets("Grafico")
Set oRange = Range("A1:O48") '<<<< range da salvare VARIARE
Set oCht = Charts.Add
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
filepath = "C:\Users\energia\Desktop\" 'dove salvare l'immagime <<<< VARIARE
ActiveSheet.Export Filename:=filepath & "Foglio1.jpg", FilterName:="jpg" '<<<< VARIARE NOME
ActiveSheet.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Foglio1 creato"
End Sub
Non so se puoi aiutarmi in qualche modo.
Grazie comunque ancora 😀 |
| | Post: 6.665 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | ONLINE |
|
| 14/01/2022 15:18 | |
Ciao Scusa ma non fai prima ad usare il cattura schermo di windows?
non ti crei problemi poi di copiare la macro su ogni file excel.
Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 2 | Registrato il: 14/01/2022
| Età: 31 | Utente Junior | 2016 | | OFFLINE | |
|
| 14/01/2022 15:21 | |
Grazie per l'informazione ma mi serve davvero la macro :) |
| | Post: 6.666 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | ONLINE |
|
| 14/01/2022 15:24 | |
ok
vedo cosa posso fare, bye bye
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 3.265 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
| 14/01/2022 16:48 | |
ciao
si, hai ragione....mi è rimasta nella penna la subroutine.....
La macro da eseguire è sub mImage che a sua volta richiamerà la SaveImage.
questo il codice
saluti
Sub mImage()
Dim wsSheet As Worksheet, oRange As Range, oCht As Chart, oImg As Picture
Application.ScreenUpdating = False
On Error Resume Next
Sheets("mGraf").Select
If ActiveSheet.Name = "mGraf" Then
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
Set oRange = Range("A1:O48") '<<<< VARIARE
Set oCht = Charts.Add
oCht.Name = "mGraf"
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
ActiveChart.Shapes("Picture 1").Select
Selection.Copy
Sheets("Foglio1").Select ' <<<< Tuo foglio con range da salvare
ActiveSheet.Paste
Sheets("mGraf").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
SaveImages
ActiveSheet.Pictures.Delete
Application.ScreenUpdating = True
End Sub
Sub SaveImages()
Dim shp As Shape, ImageName As String, Temp As Object, tArea As Object, x As Long
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
x = x + 1
ImageName = "Foglio1" ' Nome file jpg
shp.Select
Application.Selection.CopyPicture
Set Temp = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)
Set tArea = Temp.Chart
Temp.Activate
With tArea
.ChartArea.Select
.Paste
.Export ("C:\Users\energia\Desktop\" & ImageName & ".jpg")
End With
Temp.Delete
DoEvents
End If
Next
End Sub[Modificato da dodo47 14/01/2022 23:16] Domenico
Win 10 - Excel 2016 |
| | Post: 3 | Registrato il: 14/01/2022
| Età: 31 | Utente Junior | 2016 | | OFFLINE | |
|
| 17/01/2022 10:14 | |
Ti ringrazio davvero tanto!!
Adesso è perfetta 😉😉 |
|
|
|
|