ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Insert from paint and resize (https://www.excelbanter.com/excel-programming/451319-insert-paint-resize.html)

[email protected]

Insert from paint and resize
 
Group: microsoft.public.excel.programming
https://groups.google.com/forum/#!to...ng/UqUQQ0Qokpg
Subject: insert from paint & resize

Hi

I hope someone can help with this. I use the code below which launches MS Paint, the user then signs within Paint (using the Touchpad on a laptop) the macro then closes Paint and the signature is placed in cell B39.

BUT . . . whatever I've tried it is never sized correctly - the graphic is usually too deep (the height of it is too high, so it's deeper than row 39 and 40). I've tried using the "Height" and "Width" options (and the top & left options) but they place the object in cell A1. The Sendkeys lines in the code work OK to get the box in and at a decent size but always

I've also tried using vba to adjust the row heights before and after the object is inserted and it's still not quite right.

So near and yet, so far . . . basically I have the code to get the signature in, what I need is some code to select the inserted object and resize it - or any alternative anyone can think of to achieve a signature from Paint in that cell.

any help greatly appreciated!

Steve




Range("B39").Select

Set SigPic = ActiveSheet.OLEObjects.Add(ClassType:="Paint.Pictu re", Link:=False, DisplayAsIcon:=False).Activate
SendKeys "%f"
SendKeys "%e"
SendKeys "%i"
SendKeys "%w"
SendKeys "4.25"
SendKeys "{TAB}"
SendKeys "1"
SendKeys "{Enter}"

Claus Busch

Insert from paint and resize
 
Hi Steven,

Am Thu, 25 Feb 2016 04:38:13 -0800 (PST) schrieb :

So near and yet, so far . . . basically I have the code to get the signature in, what I need is some code to select the inserted object and resize it - or any alternative anyone can think of to achieve a signature from Paint in that cell.


try after inserting the pictu

With SigPic
.Top = Range("B39").Top
.Height = Range("B39").Height
.Left = Range("B39").Left
.Width = Range("B39").Width
End With


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[email protected]

Insert from paint and resize
 
Hi Claus

thanks for this fast response. The Paint object doesn't seem to be picking up the SigPic name . . . once it's inserted, if I select it, it's named "Object1" (and of course the number increments for each new Paint object I insert).

Perhaps the line of code that inserts the Paint object needs modifying, but I can't see where or how, it looks pretty good to me !!??

Set SigPic = ActiveSheet.OLEObjects.Add(ClassType:="Paint.Pictu re", Link:=False, DisplayAsIcon:=False).Activate


Cheers!

Steve



On Thursday, 25 February 2016 13:22:44 UTC, Claus Busch wrote:
Hi Steven,

Am Thu, 25 Feb 2016 04:38:13 -0800 (PST) schrieb :

So near and yet, so far . . . basically I have the code to get the signature in, what I need is some code to select the inserted object and resize it - or any alternative anyone can think of to achieve a signature from Paint in that cell.


try after inserting the


pictu

With SigPic
.Top = Range("B39").Top
.Height = Range("B39").Height
.Left = Range("B39").Left
.Width = Range("B39").Width
End With


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional



Claus Busch

Insert from paint and resize
 
Hi Steve,

Am Thu, 25 Feb 2016 08:35:53 -0800 (PST) schrieb :

thanks for this fast response. The Paint object doesn't seem to be picking up the SigPic name . . . once it's inserted, if I select it, it's named "Object1" (and of course the number increments for each new Paint object I insert).

Perhaps the line of code that inserts the Paint object needs modifying, but I can't see where or how, it looks pretty good to me !!??


the OP should save a signature and insert it from this path. So he save
signing for each workbook.

Save a signature, modify the path in the code and test it:

Dim SigPic As Picture

Set SigPic = ActiveSheet.Pictures.Insert("C:\Users\claus\OneDri ve\Bilder\Screenshots\Signature.jpg")

With Range("B39")
SigPic.Top = .Top
SigPic.Height = .Height
SigPic.Left = .Left
SigPic.Width = .Width
End With


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[email protected]

Insert from paint and resize
 
Hi

That worked perfectly, the signature was placed exactly as I need it, BUT, I need the user to be able to collect a signature from a customer, so it won't be an existing file, so the launching paint option is still required. What I'm saying is, I want the user to click a button which launches our macro, the customer signs within MSPaint, when MSPaint is closed the signature ends up perfectly places, as per the last piece of code.

Thanks again.

Steve

Claus Busch

Insert from paint and resize
 
Hi Steve,

Am Thu, 25 Feb 2016 09:22:02 -0800 (PST) schrieb :

That worked perfectly, the signature was placed exactly as I need it, BUT, I need the user to be able to collect a signature from a customer, so it won't be an existing file, so the launching paint option is still required. What I'm saying is, I want the user to click a button which launches our macro, the customer signs within MSPaint, when MSPaint is closed the signature ends up perfectly places, as per the last piece of code.


I didn't import pictures from Paint yet :-(

But look again in your former post:
https://groups.google.com/forum/#!to...ng/RYsIDvjo9Ew
There is another suggestion.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[email protected]

Insert from paint and resize
 
Hi Claus

I see. Do you think it'll be possible with the import pictures from Paint?

Steve

Claus Busch

Insert from paint and resize
 
Hi Steve,

Am Thu, 25 Feb 2016 10:25:47 -0800 (PST) schrieb :

I see. Do you think it'll be possible with the import pictures from Paint?


I have no experience in that.

But I have done it now with a workaround. The last inserted picture has
the highest number and is

With ActiveSheet
Set shp = .Shapes(.Shapes.Count)


Try:
Sub Test()
Dim shp As Shape

On Error Resume Next
Set SigPic = ActiveSheet.OLEObjects.Add(ClassType:="Paint.Pictu re",
Link:=False, DisplayAsIcon:=False).Activate

With ActiveSheet
Set shp = .Shapes(.Shapes.Count)
End With

With Range("B39")
shp.Top = .Top
shp.Left = .Left
shp.Width = .ColumnWidth
shp.Height = .Height
End With
End Sub

the inserted picture has by default aspect ratio locked. Therefore the
width can not be larger than the heigth.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

[email protected]

Insert from paint and resize
 
Claus that looks great! I'm gonna try it tomorrow as I'm going out for the evening. Have a terrific evening yourself.

Steve

[email protected]

Insert from paint and resize
 
Hi Claus

I think I've finally got this doing what we want with the code below. I've also had to move the signature to row 40.

This whole issue was seriously frustrating, as I sent a working version to my user last night and it didn't work on his laptop; this morning I adapted with your code and it STILL didn't work for him. We sent it to several other users and it was fine on their computers, so an anomaly on his laptop!!

Anyway, I believe and hope this is now concluded, so a HUGE "Thank You" to yourself for your knowledge, assistance and patience.

Steve


Sub aSignature1()
Dim shp As Shape
Range("B40").Select
On Error Resume Next

Set SigPic = ActiveSheet.OLEObjects.Add(ClassType:="Paint.Pictu re", Link:=False, DisplayAsIcon:=False).Activate
Application.Wait Now + TimeValue("00:00:01")
SendKeys "%f"
SendKeys "%e"
SendKeys "%i"
SendKeys "%w"
SendKeys "4.25"
SendKeys "{TAB}"
SendKeys "1"
SendKeys "{Enter}"

With ActiveSheet
Set shp = .Shapes(.Shapes.Count)
End With

With Range("B40")
shp.Top = .Top - 10
shp.Left = .Left
shp.Width = .ColumnWidth * 2
shp.Height = .RowHeight * 0.75
End With
End Sub


All times are GMT +1. The time now is 08:16 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com