Operating Ms Paint using excel-VBA

[kera404]

I've written a code to copy the charts from a worksheet (in my excel workbook) to Ms-Paint and then saving the results.

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">[COLOR=#101094]Sub[/COLOR][COLOR=#303336] paintCharts[/COLOR][COLOR=#303336]()[/COLOR][COLOR=#303336]
ThisWorkbook[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Sheets[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"DesiredData"[/COLOR][COLOR=#303336]).[/COLOR][COLOR=#303336]Activate
[/COLOR][COLOR=#101094]With[/COLOR][COLOR=#303336] ActiveSheet[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]ChartObjects[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]ShapeRange[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Group
    [/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]CopyPicture
    [/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Ungroup
[/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]With[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] path_Paint [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]String[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] paintID [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#101094]Variant[/COLOR][COLOR=#303336]
path_Paint [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]"C:\Windows\System32\mspaint.exe"[/COLOR][COLOR=#303336]
paintID [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] Shell[/COLOR][COLOR=#303336]([/COLOR][COLOR=#303336]path_Paint[/COLOR][COLOR=#303336],[/COLOR][COLOR=#303336] vbNormalFocus[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Call[/COLOR][COLOR=#303336] AppActivate[/COLOR][COLOR=#303336]([/COLOR][COLOR=#303336]paintID[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]Call[/COLOR][COLOR=#303336] SendKeys[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"^V"[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]
[/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]Sub[/COLOR]</code>

I am getting an error at the <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: pre-wrap; color: rgb(36, 39, 41); background-color: rgb(239, 240, 241);">Call AppActivate(paintID)</code> further, I want to ask if by calling <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: pre-wrap; color: rgb(36, 39, 41); background-color: rgb(239, 240, 241);">Call SendKeys("^V")</code> and then <code style="margin: 0px; padding: 1px 5px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: pre-wrap; color: rgb(36, 39, 41); background-color: rgb(239, 240, 241);">Call SendKeys("^S")</code> will do the job.

 

[Xstreme]

Hi Kera

It looks something like this....

Dim path As String

Dim MyAppID As Variant


Range("A9:BZ25").Select
Range("AD14").Activate
Selection.Copy

path = "C:\Windows\system32\mspaint.exe"

MyAppID = Shell(path, 1)

Application.Wait (Now + TimeValue("0:00:05"))

AppActivate (MyAppID)

Application.Wait (Now + TimeValue("0:00:05"))

Application.SendKeys "^v", True

Application.SendKeys "^s", True


You can still send keys for selecting a file name and will be a case of just saving...

Hope this helps you....

 

[kera404]

Application.Wait worked just fine, but Application.SendKeys "^V",true ... is not pasting Charts into mspaint

Hi Kera

It looks something like this....

Dim path As String

Dim MyAppID As Variant


Range("A9:BZ25").Select
Range("AD14").Activate
Selection.Copy

path = "C:\Windows\system32\mspaint.exe"

MyAppID = Shell(path, 1)

Application.Wait (Now + TimeValue("0:00:05"))

AppActivate (MyAppID)

Application.Wait (Now + TimeValue("0:00:05"))

Application.SendKeys "^v", True

Application.SendKeys "^s", True


You can still send keys for selecting a file name and will be a case of just saving...

Hope this helps you....

 

[Xstreme]

if you look at the code it has a small v and not a capital v....

same goes for the s, it has to be small letters.