Previous page | 1 | Next page

Macro per creare istantanea su Excel

Last Update: 1/17/2022 10:14 AM
Author
Print | Email Notification    
Post: 1
Registered in: 1/14/2022
Age: 29
Junior User
2016
OFFLINE
1/14/2022 12:10 PM
 
Modify
 
Delete
 
Quote

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
Registered in: 4/6/2013
Location: ROMA
Age: 74
Master User
2010
OFFLINE
1/14/2022 12:37 PM
 
Modify
 
Delete
 
Quote

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 Sub

Domenico
Win 10 - Excel 2016
Post: 1
Registered in: 1/14/2022
Age: 29
Junior User
2016
OFFLINE
1/14/2022 3:03 PM
 
Modify
 
Delete
 
Quote

Ci siamo quasi! :D
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
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
1/14/2022 3:18 PM
 
Modify
 
Delete
 
Quote

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 aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie





Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 2
Registered in: 1/14/2022
Age: 29
Junior User
2016
OFFLINE
1/14/2022 3:21 PM
 
Modify
 
Delete
 
Quote

Grazie per l'informazione ma mi serve davvero la macro :)
Post: 6,666
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
1/14/2022 3:24 PM
 
Modify
 
Delete
 
Quote

ok
vedo cosa posso fare, bye bye
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 3,265
Registered in: 4/6/2013
Location: ROMA
Age: 74
Master User
2010
OFFLINE
1/14/2022 4:48 PM
 
Modify
 
Delete
 
Quote

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
[Edited by dodo47 1/14/2022 11:16 PM]
Domenico
Win 10 - Excel 2016
Post: 3
Registered in: 1/14/2022
Age: 29
Junior User
2016
OFFLINE
1/17/2022 10:14 AM
 
Modify
 
Delete
 
Quote

Ti ringrazio davvero tanto!!
Adesso è perfetta 😉😉
Admin Thread: | Close | Move | Delete | Modify | Email Notification Previous page | 1 | Next page
New Thread
 | 
Reply
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Users | Search | Log In | Register | Admin
Tutti gli orari sono GMT+01:00. Adesso sono le 12:53 AM. : Printable | Mobile | Regolamento | Privacy
FreeForumZone [v.6.0] - Copyright © 2000-2022 FFZ srl - www.freeforumzone.com