Macro to take screenshot then save to desktop without user intervention

[becklog]

Not sure if this is even possible but I am looking for a vba script that will allow me to screenshot my screen, save it to a specific path and use a specific filename format without user intervention. It's like when I click the button it will automatically save it to my desired path without clicking anything else.

 

[yky]

Sub savescreen()

Dim r As Range
Dim oCht As Chart

Set r = Application.ActiveWindow.VisibleRange

r.CopyPicture xlScreen, xlBitmap
Set oCht = Charts.Add

With oCht
    .Paste
    .Export Filename:="C:\users\Administrator\desktop\SavedScreen.jpg", Filtername:="JPG"
End With

Application.DisplayAlerts = False
oCht.Delete
Application.DisplayAlerts = True

End Sub

 

[Logit]

.
From the description in your request, I believe this code will fulfill the requirements. Note the comments on the first sheet of the workbook. Download link is :https://www.amazon.com/clouddrive/share/Gijxxlw7nKoRLabWZa71L5tTQTkWKRzBN8m5MKVBHaa

Option Explicit


' standard module
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
 bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)




Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal Index As Long) As Long
Declare Function GetSystemMetrics16 Lib "user" Alias "GetSystemMetrics" _
(ByVal nIndex As Integer) As Integer




Private Const KEYEVENTF_KEYUP = &H2     ' key up
Private Const VK_SNAPSHOT = &H2C        ' print screen key
Private Const VK_MENU = &H12            ' alt key
Private Const VK_CONTROL = &H11         ' ctrl key




Sub ScreensCapture(vk)
keybd_event vk, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 1
keybd_event vk, 0, KEYEVENTF_KEYUP, 0
End Sub




Sub Window_Capture_VBA(Optional sTitle = "")
Application.CutCopyMode = False
If sTitle <> "" Then
    AppActivate sTitle
    Application.Wait Now() + TimeValue("00:00:03")
    ScreensCapture VK_MENU
Else
    ScreensCapture VK_CONTROL
End If
Application.Wait Now() + TimeValue("00:00:03")
Sheets("Sheet1").Paste
Selection.Left = 0
Selection.Top = 0
Application.CutCopyMode = False
End Sub


' sheet module
Sub Main()
Dim r As Range
Window_Capture_VBA
Selection.Name = ActiveCell
ExportPicture ActiveCell
Set r = Cells(ActiveCell.Row, ActiveCell.Column + 5)
ActiveSheet.Hyperlinks.Add r, "C:\Users\My\Desktop\" & ActiveCell & ".jpg", , , ActiveCell.Value
End Sub




Sub ExportPicture(im$)
Dim ch As String, pic As String, PicWidth&, PicHeight&, n$
Application.ScreenUpdating = 0
n = ActiveSheet.Name
pic = Selection.Name
With Selection
    PicHeight = .ShapeRange.Height
    PicWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=n
Selection.Border.LineStyle = 0
ch = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
    With .Shapes(ch)
        .Width = PicWidth
        .Height = PicHeight
    End With
    .Shapes(pic).Copy
    .Shapes(pic).Delete
    ActiveChart.ChartArea.Select
    ActiveChart.Paste
    .ChartObjects(1).Chart.Export Filename:="c:\Users\My\Desktop\" & im & ".jpg", FilterName:="jpg"
    .Shapes(ch).Cut
End With
Application.ScreenUpdating = True
MsgBox "Image created and saved."
End Sub




Sub TakePic()
    Main
End Sub

 

[becklog]

Thank you for this. This is exactly what I am looking for. I just did some editing. Awesome!

 

[Logit]

You are welcome.

 

[Martinpetersson]

Thank you for this. This is exactly what I am looking for. I just did some editing. Awesome!

I have an excel sheet (dash board) that is opened on a screen 24 hours a day.
Do you know if it is possible for excel to take a screenshot automatically every day. And then send it to an e-mail address?