![]() |
#1
|
|||
|
|||
![]()
Hi
Can you make two amendments to the code below,if so it would be greatly appreciated? 1) so it places/aligns the bottom of the image so it is 11cm from the top 2) so instead of being 30% of the original size, it scales height to 171.5 and reduces width accordingly to scale Full code as below: Sub ATopLeft() Dim oshp1 As Shape Dim oshp2 As Shape If ActiveWindow.Selection.ShapeRange.Count <> 2 Then Exit Sub Set oshp1 = ActiveWindow.Selection.ShapeRange(1) Set oshp2 = ActiveWindow.Selection.ShapeRange(2) oshp1.Width = oshp1.Width * 0.30 oshp2.Width = oshp2.Width * 0.30 oshp1.Top = cm2Points(2) oshp2.Top = cm2Points(2) oshp2.Left = oshp1.Left + oshp1.Width ActiveWindow.Selection.ShapeRange.Cut With ActivePresentation.Slides(ActiveWindow.View.Slide. SlideNumber).Shapes.PasteSpecial(ppPastePNG) .Left = cm2Points(7) - .Width / 2 .Top = cm2Points(6) - .Height / 2 .Top = cm2Points(10) .Line.Visible = True .Line.ForeColor.RGB = RGB(0, 176, 80) .Line.Weight = 3 End With End Sub Cheers Andy |
#2
|
|||
|
|||
![]()
Maybe
Code:
Sub ATopLeft() Dim oshp1 As Shape Dim oshp2 As Shape If ActiveWindow.Selection.ShapeRange.Count <> 2 Then Exit Sub Set oshp1 = ActiveWindow.Selection.ShapeRange(1) Set oshp2 = ActiveWindow.Selection.ShapeRange(2) oshp1.Height = 171.5 oshp2.Height = 171.5 oshp1.Top = oshp2.Top oshp2.Left = oshp1.Left + oshp1.Width ActiveWindow.Selection.ShapeRange.Cut With ActiveWindow.View.Slide.Shapes.PasteSpecial(ppPastePNG) .Left = cm2Points(7) - .Width / 2 .Top = cm2Points(11) - 171.5 .Line.Visible = True .Line.ForeColor.RGB = RGB(0, 176, 80) .Line.Weight = 3 End With End Sub Function cm2Points(inVal As Single) As Single cm2Points = inVal * 28.346 End Function |
#3
|
|||
|
|||
![]()
Tried it and it looks good...thank you!!!
|
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
alexei_lg | Word | 1 | 02-07-2012 12:28 PM |
![]() |
sinrockz | Office | 3 | 08-19-2011 10:58 AM |
![]() |
99nasha | Word | 1 | 03-11-2011 04:24 PM |
Help-urgent help needed immediately | munstershug | PowerPoint | 1 | 05-01-2010 11:27 AM |
MS-Word 2003 Help Needed Urgent | Karthik123 | Word | 10 | 01-26-2010 08:43 PM |