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

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-10-2019, 03:09 AM
mtwa mtwa is offline Macro to paste a picture, unlock the aspect ratio and change height and width Windows 10 Macro to paste a picture, unlock the aspect ratio and change height and width Office 2016
Novice
Macro to paste a picture, unlock the aspect ratio and change height and width
 
Join Date: Apr 2016
Posts: 3
mtwa is on a distinguished road
Default Macro to paste a picture, unlock the aspect ratio and change height and width

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
Reply With Quote
  #2  
Old Yesterday, 09:17 AM
mikejvir mikejvir is offline Macro to paste a picture, unlock the aspect ratio and change height and width Windows 10 Macro to paste a picture, unlock the aspect ratio and change height and width Office 2016
Novice
 
Join Date: Nov 2019
Posts: 2
mikejvir is on a distinguished road
Default

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
Reply With Quote
Reply

Tags
macro, paste, vba

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to paste a picture, unlock the aspect ratio and change height and width Picture inserting,resizing and rotating with Macro depending on height and width Strifly Word VBA 2 11-05-2017 03:18 AM
Macro to paste a picture, unlock the aspect ratio and change height and width 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
Macro to paste a picture, unlock the aspect ratio and change height and width 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


All times are GMT -7. The time now is 09:47 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft