I've read a few forums but none of them seem to be working for me.
I'm pulling pictures from the web, and inserting them into my spreadsheet. I'd like all of these pictures to have the same dimension.
My code is as follows:
Dim img_url as string, picture as object
img_url = Range("A1") 'Some url with an img
With ActiveSheet.Pictures
Set Picture = ActiveSheet.Pictures.Insert(img_url)
Picture.LockAspectRatio = msoFalse
Picture.Width = 25
PictureHeight = 25
End With
Every time I run it, the Lock Aspect Ratio setting is still checked, and the image is not in the square format I'm looking for.
Any advice would be much appreciated.
Thanks
Use the code below, the LockAspectRatio attribute is a property of the Picture.ShapeRange object, and not the Picture.
Option Explicit
Sub ImageAttributes()
Dim img_url As String
Dim picture As Object
img_url = Range("A1") 'Some url with an img
With ActiveSheet
Set picture = .Pictures.Insert(img_url)
With picture
With .ShapeRange
.LockAspectRatio = msoFalse
.Width = 25
.Height = 25
End With
End With
End With
End Sub
Related
I received a PowerPoint file with multiple slides which were supposed to be templates (designs - customlayouts) but instead were regular slides.
Transforming them into SlideMaster and custom layouts and replacing the titles and bodys (textboxes) with actual placeholders by hand was a pain.
So I came with this script to make the process faster.
If anybody has a better approach, it's welcome.
Had to look for a workaround to get the customlayout object.
Several things are missing, for example error handling.
To test it, copy a textbox into a slidemaster layout slide, select it and run the ReplaceWithPHTitle macro
Option Explicit
Public Sub ReplaceWithPHTitle()
ReplaceTexboxWithPlaceholder ppPlaceholderTitle
End Sub
Public Sub ReplaceWithPHBody()
ReplaceTexboxWithPlaceholder ppPlaceholderBody
End Sub
Private Sub ReplaceTexboxWithPlaceholder(ByVal placeholderType As PpPlaceholderType)
Dim targetLayout As CustomLayout
Dim activeShape As Shape
Dim newPlaceHolder As Shape
Set activeShape = ActiveWindow.Selection.ShapeRange(1)
Set targetLayout = activeShape.Parent
Set newPlaceHolder = targetLayout.Shapes.AddPlaceholder(Type:=placeholderType, Left:=activeShape.Left, Top:=activeShape.Top, Width:=activeShape.Width + 15, Height:=activeShape.Height)
With newPlaceHolder.TextFrame
.TextRange.Font.Name = activeShape.TextFrame.TextRange.Font.Name
.TextRange.Characters.Font.Color.RGB = activeShape.TextFrame.TextRange.Characters.Font.Color.RGB
.TextRange.Font.Size = activeShape.TextFrame.TextRange.Font.Size
.TextRange.Font.Bold = activeShape.TextFrame.TextRange.Font.Bold
.TextRange.ParagraphFormat.Bullet.Type = activeShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type
.TextRange.ParagraphFormat.SpaceWithin = activeShape.TextFrame.TextRange.ParagraphFormat.SpaceWithin
.TextRange.ParagraphFormat.Alignment = activeShape.TextFrame.TextRange.ParagraphFormat.Alignment
.TextRange.ParagraphFormat.SpaceBefore = activeShape.TextFrame.TextRange.ParagraphFormat.SpaceBefore
.TextRange.ParagraphFormat.SpaceAfter = activeShape.TextFrame.TextRange.ParagraphFormat.SpaceAfter
.TextRange.ParagraphFormat.BaseLineAlignment = activeShape.TextFrame.TextRange.ParagraphFormat.BaseLineAlignment
.TextRange.Text = activeShape.TextFrame.TextRange.Text
End With
With newPlaceHolder.TextFrame2
.TextRange.Font.Spacing = activeShape.TextFrame2.TextRange.Font.Spacing
End With
newPlaceHolder.ZOrder msoSendToBack
newPlaceHolder.Select
End Sub
Any improvements are welcome too.
I'd like to addionaly put a slightly red transparent layer on an image in Word to indicate, that it should be deleted, because the change bar (when using the change tracking) is mostely overlooked.
So far so good, I can format the selected image:
Sub FormatPicture()
Dim inShape As InlineShape
Set inShape = Selection.InlineShapes(1)
inShape.LockAspectRatio = msoCTrue
'equals 16cm
inShape.Width = "453,9"
End Sub
But how can I colorize the image?
This worked for me
Dim inShape As InlineShape
Set inShape = Selection.InlineShapes(1)
inShape.LockAspectRatio = msoCTrue
inShape.PictureFormat.ColorType = msoPictureGrayscale
'equals 16cm
inShape.Width = "453,9"
you can play with ColorType
I think inShape.PictureFormat.ColorType = msoPictureWatermark will suit your need
My first post so sorry for any errors.
I am trying to replace a image in the header of a document. This will be done a few thousand times.
This line of code:
Set shp = ActiveDocument.Sections(1).Headers.Shapes(strPic)
Causes:
Compile error: Method or data member not found
and
Set shp = ActiveDocument.Shapes("strPic")
Causes:
Run-time error '-2147024809(80070057): The item with the specified name wasn't found.
I have written in multiple ways and cannot get it to assign shp I feel like this is a very simple issue of how I am accessing the header or maybe this whole sub is just wrong. The strPic line before get the name of the shape fine.
Sub imagerepl()
With Selection
' \\ If we selected a InlineShape then convert to Shape
If .Type = wdSelectionInlineShape Then
.InlineShapes(1).ConvertToShape
End If
End With
strPic = Selection.ShapeRange.Name
Set shp = ActiveDocument.Sections(1).Headers.Shapes(strPic)
'Capture properties of exisitng picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange(strPic).Delete
Set shp = ActiveDocument.Shapes.AddPicture("C:\Users\tk\Pictures\DFHlogo.png", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
shp.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
shp.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
End Sub
You can access the header image through the Range.InlineShapes collection. For example, the following routine would delete the first image in the collection and then add new image to the header.
Dim sh As InlineShape
With ThisDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
' Get the first (possibly only, for you) image in the header...
Set sh = .InlineShapes(1)
' Delete it...
sh.Delete
' Add a new image to the header...
Set sh = .InlineShapes.AddPicture("c:\path\to\my.jpg")
' Set its properties...
sh.Width = 100
sh.Height = 100
...
End With
I have been working on a small hack around with Power Point to automatically create a Text Box Shape with some preset effect in which the text is dynamically fetched from clipboard. I have quiet a bit of a problem here, the functionality works fine with the following VB script with macros.
Sub ReadFromFile()
' CLIPBOARD
Dim MyData As DataObject
Dim strClip As String
' CLIPBOARD
Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
Set activeDocument = ActivePresentation.Slides(1)
With activeDocument
'Set QASlide = .Slides.Add(Index:=.Slides.Count + 0, Layout:=ppLayoutBlank)
activeDocument.Shapes.AddTextEffect PresetTextEffect:=msoTextEffect28, _
Text:=strClip, _
FontName:="Garde Gothic", FontSize:=44, FontBold:=msoTrue, _
FontItalic:=msoFalse, Left:=25, Top:=25
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
End With
End Sub
Can some one help me in providing the script for wrapping the text inside the shape which has a defined width and height as in the code above?
Not sure if I understand you right but does adding .TextFrame.WordWrap = msoTrue to the block below solve your problem?
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
I think you are looking for this:
.Shapes(.Shapes.Count).TextFrame.TextRange.Text = strClip
You can set it in the same With that you are setting the height and width
If you want text to wrap within a shape, you'll have to use something other than a texteffect shape.
I found a VBA macro online that resizes all the images in a Word document:
Sub ResizeAllImages()
''# make all images (both inline and floating)
''# 11 cm wide while preserving aspect ratio
Dim oShp As Shape
Dim oILShp As InlineShape
For Each oShp In ActiveDocument.Shapes
With oShp
.Height = AspectHt(.Width, .Height, _
CentimetersToPoints(11))
.Width = CentimetersToPoints(11)
End With
Next
For Each oILShp In ActiveDocument.InlineShapes
With oILShp
.Height = AspectHt(.Width, .Height, _
CentimetersToPoints(11))
.Width = CentimetersToPoints(11)
End With
Next
End Sub
I couldn't find the name of a method that I could use to center-align all images.
Does anyone know what I need to add, and where I would have to add it?
Lastly, I'd like to delete images that I find to be too small.
How would I do... If width of shape is smaller than 5, and height of shape is smaller than 5, delete the shape.
For easier reading of large amounts of online text, I sometimes like to paste everything in word, and then rearrange it.
I replace every period-whitespace, with a period-manual line, which gives me a new line for each sentence.. I read better when it's like that. Since I'm pasting everything, the graphics comes too, so I'd like to be able to control the size of all the images, and get rid of any unnecessary images.
I think you cannot center-align images. You can center-align paragraphs. Perhaps something like this will help you:
For Each oILShp In ActiveDocument.InlineShapes
oILShp.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next
For deletion, just call Delete for each Shape object satisfying your conditions.
http://yuriy-okhmat.blogspot.co.uk/2011/07/how-to-resize-all-images-in-word.html
Has the full code including definition of AspectHt
Code to delete small pictures:
Sub DeleteSmallPictures()
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
With iShp
If .Width < CentimetersToPoints(5) Then
iShp.Delete
End If
End With
Next iShp
End Sub