Macro to paste a picture, unlock the aspect ratio and change height and width

mtwa · #1 10-10-2019, 03:09 AM

I would like to find an easier way to paste a picture i have copied into word and change the width and height in one easy shortcut.

I currently take a snapshot of my screen then in word paste the snapshot, change the layout to 'infront of text', right click on the picture and go to 'size and position...', uncheck the 'lock aspect ratio' check box then change the height to 5 and width to 9.

I have tried recording a macro however this doesnt seem to work. when im recording the macro i am unable to right click on the picture to select 'size and position.'

i want to be able to open word then press 'ctrl 1' on the keyboard so the picture pastes then the width is changed to 9 and height to 5. i dont even mind pasting first 'ctrl v' then 'ctrl 1' after to resize the picture.

Thank You for your help

mikejvir · #2 11-13-2019, 09:17 AM

Hello,

Here is code I wrote to paste an excel chart that is in the clipboard. You should be able to make this work

Code:

Sub PasteFormatExcelChart()
'
' Macro created to paste an Excel Chart (Image) into PowerPoint with a maximum height of 5.9 inches.
'
' 2016-06-27  Modified for a maximum height of 5.7 and allowed  the height or width
'  to control the scaling.
'
Dim shapewidth As Double
Dim shapeheight As Double
Dim maxheight As Double
Dim maxwidth As Double

maxheight = 5.7 * 72 ' points
maxwidth = 9 * 72    ' points

  ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
  With ActiveWindow.Selection.ShapeRange
   '  .Fill.Transparency = 0#
    .LockAspectRatio = True
    shapewidth = .Width
    shapeheight = .Height
    If shapewidth / maxwidth > shapeheight / maxheight Then
      .Width = Round(maxwidth)
      shapeheight = .Height
      .Left = Round(0.75 * 72)
      .Top = Round(1.2 * 72) - Round((maxheight - shapeheight) / 2)
    Else
      .Height = Round(maxheight)
      shapewidth = .Width
      .Left = Round((maxwidth + 72 - shapewidth) / 2)
      .Top = Round(1.2 * 72)
    End If
  End With
  ActiveWindow.Selection.Unselect

End Sub

Michael Virostko

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Picture inserting,resizing and rotating with Macro depending on height and width	Strifly	Word VBA	2	11-05-2017 03:18 AM
Aspect Ratio for New Template	pptdiva	PowerPoint	2	01-27-2015 02:30 PM
Aspect Ratio problem	naomidlee@gmail.com	PowerPoint	0	12-22-2013 04:24 AM
Height and Width blank - Excel Chart in Powerpoint	Metronome	PowerPoint	1	04-06-2012 06:20 AM
Keeping the aspect ratio	Jordan6161	PowerPoint	0	07-22-2011 05:50 PM