Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #108569 > unrolled thread

Insert from paint and resize

Back to article view | Back to microsoft.public.excel.programming

Contents

  Insert from paint and resize Steven@pctamers.eu - 2016-02-25 04:38 -0800
    Re: Insert from paint and resize Claus Busch <claus_busch@t-online.de> - 2016-02-25 14:22 +0100
      Re: Insert from paint and resize Steven@pctamers.eu - 2016-02-25 08:35 -0800
        Re: Insert from paint and resize Claus Busch <claus_busch@t-online.de> - 2016-02-25 18:09 +0100
          Re: Insert from paint and resize Steven@pctamers.eu - 2016-02-25 09:22 -0800
            Re: Insert from paint and resize Claus Busch <claus_busch@t-online.de> - 2016-02-25 18:34 +0100
              Re: Insert from paint and resize Steven@pctamers.eu - 2016-02-25 10:25 -0800
                Re: Insert from paint and resize Claus Busch <claus_busch@t-online.de> - 2016-02-25 19:53 +0100
                  Re: Insert from paint and resize Steven@pctamers.eu - 2016-02-26 06:44 -0800
    Re: Insert from paint and resize Steven@pctamers.eu - 2016-02-25 11:13 -0800

#108569 — Insert from paint and resize

Group: microsoft.public.excel.programming
https://groups.google.com/forum/#!topic/microsoft.public.excel.programming/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.Picture", Link:=False, DisplayAsIcon:=False).Activate
SendKeys "%f"
SendKeys "%e"
SendKeys "%i"
SendKeys "%w"
SendKeys "4.25"
SendKeys "{TAB}"
SendKeys "1"
SendKeys "{Enter}"

[toc] | [next] | [standalone]

#108570

Hi Steven,

Am Thu, 25 Feb 2016 04:38:13 -0800 (PST) schrieb Steven@pctamers.eu:

> 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 picture:

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

[toc] | [prev] | [next] | [standalone]

#108572

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.Picture", 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

 picture:
> 
> 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

[toc] | [prev] | [next] | [standalone]

#108574

Hi Steve,

Am Thu, 25 Feb 2016 08:35:53 -0800 (PST) schrieb Steven@pctamers.eu:

> 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\OneDrive\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

[toc] | [prev] | [next] | [standalone]

#108575

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

[toc] | [prev] | [next] | [standalone]

#108576

Hi Steve,

Am Thu, 25 Feb 2016 09:22:02 -0800 (PST) schrieb Steven@pctamers.eu:

> 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/#!topic/microsoft.public.excel.programming/RYsIDvjo9Ew
There is another suggestion.


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

[toc] | [prev] | [next] | [standalone]

#108578

Hi Claus

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

Steve

[toc] | [prev] | [next] | [standalone]

#108580

Hi Steve,

Am Thu, 25 Feb 2016 10:25:47 -0800 (PST) schrieb Steven@pctamers.eu:

> 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.Picture",
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

[toc] | [prev] | [next] | [standalone]

#108586

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.Picture", 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

[toc] | [prev] | [next] | [standalone]

#108581

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

Steve

[toc] | [prev] | [standalone]

Back to top | Article view | microsoft.public.excel.programming

csiph-web