Saving New Screenshot on New Column

[iSoleil]

Hi guys,

I'm having trouble adding another column for my screenshots. What I need is to be able to click the same command button then if the +5 column is occupied for it to take a new screenshot and place it in +6 column.

The code below does that but it doesn't save as a new image. It replaces the previous screenshot saved from +5 with a new screenshot with the same file name. How can I make this code work so it runs a search on the Screenshot folder that I have and return it with a new file name if it's a repeat name?

I can also do with saving the screenshot as "activecellname_hh:mm:ss" that the screenshot was taken. I think that'll simplify my request? lol, not sure. Anyway, here's the code I use. Thanks in advance!

Standard module:

'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")
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Sheet module:

Sub Main()
Dim r As Range, n$
Call lastcellonB
Window_Capture_VBA "Reflection Workspace - [Mortgage Processing Express]"
Me.[v1] = "Header"
Me.[ab:ac].ClearContents
Me.[ab1] = "Header"
Me.[ab2] = ActiveCell
Me.Range("v:v").AdvancedFilter xlFilterCopy, Me.[ab1:ab2], Me.[ac1], 0
n = ActiveCell & "_" & Me.Range("ac" & Rows.Count).End(xlUp).Row - 1
Selection.Name = n
ExportPicture n
If Cells(ActiveCell.Row, ActiveCell.Column + 5) = "" Then
Set r = Cells(ActiveCell.Row, ActiveCell.Column + 5)
Me.Hyperlinks.Add r, "H:\Support Tracker\Screenshots\" & n & ".jpg", , , n
Else
    Set r = Cells(ActiveCell.Row, ActiveCell.Column + 6)
    Me.Hyperlinks.Add r, "H:\Support Tracker\Screenshots\" & n & ".jpg", , , n
    End If
End Sub

 

[iSoleil]

Update:

This has been resolved under thread: https://www.mrexcel.com/forum/excel...ased-cell-value-save-paste-link-saved-ss.html