I am looking for a way to insert a picture from a folder into a specific cell in excel. The folder contains hundreds of pictures. I am not familiar with excel macros or VBA. The way the code should work is I type the picture name into a cell and the result should extract a picture with the same name from that folder and place it into another cell. The picture being inserted should also be resized. If someone could please give me some guidance as to how this could be done. Thanks. I am sorry for my poor English as it is my second language.
Assuming you are typing your image name as "myImage.jpg" into cell A1 of your worksheet. Make sure it is the full name with the extension. Place this into your worksheet code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim imagePath, fullImagePath, newImageLoc As String
imagePath = "C:\YourFileLocationPath\" 'set this to where your images are located.
If Target.Address = "$A$1" Then 'Assumming the cell you are entering your image is in A1 or change to whatever cell you want entering in.
fullImagePath = imagePath & Target.Value
newImageLoc = Target.Offset(, 2).Address ' this moves the new image location to the cell you enter your image name two columns to the right.
'Adjusts image size, change as needed
With ActiveSheet.Pictures.Insert(fullImagePath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
.Left = ActiveSheet.Range(newImageLoc).Left
.Top = ActiveSheet.Range(newImageLoc).Top
.Placement = 1
.PrintObject = True
End With
End
End If
End Sub
I am having issues with inserting a picture in portrait mode using VBA. If the picture is in landscape mode, then the picture is inserted into the associated shape in column B. However, if the picture is in portrait, then the picture is offset 25 columns to column AA. Any help is greatly appreciated!
Sub cmdInsert1_Click()
Dim myPicture As String, MyObj As Object
Range("b5").Select
myPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If myPicture = "False" Then Exit Sub
Set MyObj = ActiveSheet.Shapes.AddPicture(myPicture, False, True, Range("B5").Left, Range("B5").Top, -1, -1)
With MyObj
.Height = 293
.Locked = False
End With
Set MyObj = Nothing
End Sub
Windows "remembers" the orientation of the picture, so what is in the Top Left corner of your screen may not actually be the Top Left corner of the picture. You will need to check the .Rotation property of your picture. If it's rotated (ie, not 0), you will need to adjust your code accordingly. For example:
If myObj.Rotation = 0 Or myObj.Rotation = 180 Then
.Height = 293
Else
.Width = 293
End If
Edit: Forgot to account for it merely being upside down
I have the following code:
Range("A1:M28").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Sheets.Add.Name = "Without Formatting"
Worksheets("Without Formatting").Paste _
Destination:=Worksheets("Without Formatting").Range("A1:M28")
That copies some cells then pastes them as a picture in another worksheet, is there a way of saving the picture (preferably as a jpeg) into a specific location so that I can then use the picture in an email?
I have used the following in the past. It copies the cells as an image, creates a new chart, paste the image into the chart, export the chart as an image then deletes the chart.
Range("A1:M28").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set cht = ActiveSheet.ChartObjects.Add(0, 0, Rng.Width + 0.01, Rng.Height + 0.01)
cht.Name = "tempchart"
cht.Chart.Paste
ActiveChart.Shapes.Range(Array("chart")).Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
ActiveSheet.ChartObjects("tempchart").Activate
ActiveSheet.Shapes("tempchart").Fill.Visible = msoFalse
ActiveSheet.Shapes("tempchart").Line.Visible = msoFalse
cht.Chart.Export strPath & "c:\filepath\imagename.jpg"
ActiveSheet.ChartObjects.Delete
Hopefully that will help,
I am trying to use VBA to automate the Change Picture function when you right click a Shape in Excel/Word/Powerpoint.
However, I am not able to find any reference, can you assist?
So far as I know you can't change the source of a picture, you need to delete the old one and insert a new one
Here's a start
strPic ="Picture Name"
Set shp = ws.Shapes(strPic)
'Capture properties of exisitng picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
ws.Shapes(strPic).Delete
Set shp = ws.Shapes.AddPicture("Y:\our\Picture\Path\And\File.Name", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
shp.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
shp.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue
You can change the source of a picture using the UserPicture method as applied to a rectangle shape. However, you will need to resize the rectangle accordingly if you wish to maintain the picture's original aspect ratio, as the picture will take the dimensions of the rectangle.
As an example:
ActivePresentation.Slides(2).Shapes(shapeId).Fill.UserPicture ("C:\image.png")
'change picture without change image size
Sub change_picture()
strPic = "Picture 1"
Set shp = Worksheets(1).Shapes(strPic)
'Capture properties of exisitng picture such as location and size
With shp
t = .Top
l = .Left
h = .Height
w = .Width
End With
Worksheets(1).Shapes(strPic).Delete
Set shp = Worksheets(1).Shapes.AddPicture("d:\pic\1.png", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
End Sub
what I do is lay both images on top of eachother, and assign the macro below to both images. Obviously i've named the images "lighton" and "lightoff", so make sure you change that to your images.
Sub lightonoff()
If ActiveSheet.Shapes.Range(Array("lighton")).Visible = False Then
ActiveSheet.Shapes.Range(Array("lighton")).Visible = True
Else
ActiveSheet.Shapes.Range(Array("lighton")).Visible = False
End If
End Sub
What I've done in the past is create several image controls on the form and lay them on top of each other. Then you programmatically set all images .visible = false except the one you want to show.
In Word 2010 VBA it helps to change the .visible option for that picture element you want to change.
set the .visible to false
change the picture
set the .visilbe to true
that worked for me.
I tried to imitate the original function of 'Change Picture' with VBA in PowerPoinT(PPT)
The code below tries to recover following properties of the original picture:
- .Left, .Top, .Width, .Height
- zOrder
- Shape Name
- HyperLink/ Action Settings
- Animation Effects
Option Explicit
Sub ChangePicture()
Dim sld As Slide
Dim pic As Shape, shp As Shape
Dim x As Single, y As Single, w As Single, h As Single
Dim PrevName As String
Dim z As Long
Dim actions As ActionSettings
Dim HasAnim As Boolean
Dim PictureFile As String
Dim i As Long
On Error GoTo ErrExit:
If ActiveWindow.Selection.Type <> ppSelectionShapes Then MsgBox "Select a picture first": Exit Sub
Set pic = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
'Open FileDialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Picture File", "*.emf;*.jpg;*.png;*.gif;*.bmp"
.InitialFileName = ActivePresentation.Path & "\"
If .Show Then PictureFile = .SelectedItems(1) Else Exit Sub
End With
'save some properties of the original picture
x = pic.Left
y = pic.Top
w = pic.Width
h = pic.Height
PrevName = pic.Name
z = pic.ZOrderPosition
Set actions = pic.ActionSettings 'Hyperlink and action settings
Set sld = pic.Parent
If Not sld.TimeLine.MainSequence.FindFirstAnimationFor(pic) Is Nothing Then
pic.PickupAnimation 'animation effect <- only supported in ver 2010 above
HasAnim = True
End If
'insert new picture on the slide
Set shp = sld.Shapes.AddPicture(PictureFile, False, True, x, y)
'recover original property
With shp
.Name = "Copied_ " & PrevName
.LockAspectRatio = False
.Width = w
.Height = h
If HasAnim Then .ApplyAnimation 'recover animation effects
'recover shape order
.ZOrder msoSendToBack
While .ZOrderPosition < z
.ZOrder msoBringForward
Wend
'recover actions
For i = 1 To actions.Count
.ActionSettings(i).action = actions(i).action
.ActionSettings(i).Run = actions(i).Run
.ActionSettings(i).Hyperlink.Address = actions(i).Hyperlink.Address
.ActionSettings(i).Hyperlink.SubAddress = actions(i).Hyperlink.SubAddress
Next i
End With
'delete the old one
pic.Delete
shp.Name = Mid(shp.Name, 8) 'recover name
ErrExit:
Set shp = Nothing
Set pic = Nothing
Set sld = Nothing
End Sub
How to use:
I suggest you to add this macro into the Quick Access Toolbar list.
(Goto Option or Right-click on the Ribbon menu))
First, select a Picture on the slide which you want to change.
Then, if the FileDialog window opens, choose a new picture.
It's done. By using this method, you can bypass the 'Bing Search and One-Drive Window' in ver 2016 when you want to change a picture.
In the code, there might(or should) be some mistakes or something missing.
I'd appreciate it if somebody or any moderator correct those errors in the code.
But mostly, I found that it works fine.
Also, I admit that there are still more properties of the original shape to recover - like the line property of the shape, transparency, pictureformat and so on.
I think this can be a beginning for people who want to duplicate those TOO MANY properties of a shape.
I hope this is helpful to somebody.
i use this code :
Sub changePic(oshp As shape)
Dim osld As Slide
Set osld = oshp.Parent
osld.Shapes("ltkGambar").Fill.UserPicture (ActivePresentation.Path & "\" & oshp.Name & ".png")
End Sub
I'm working in Excel and VBA. I can't overlay images because I have multiple sheets of a variable number and each sheet has the images, so the file would get huge if, say 20 sheets had all 5 images I want to animate.
So I used a combination of these tricks listed here:
1) I inserted an RECTANGLE shape at the location and size I wanted:
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1024#, 512#, 186#, 130#).Select
Selection.Name = "SCOTS_WIZARD"
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "G:\Users\ScotLouis\Documents\My Spreadsheets\WordFind Wizard\WordFind Wizard 1.jpg"
.TextureTile = msoFalse
End With
2) Now to animate (change) the picture, I only need to change the Shape.Fill.UserPicture:
ActiveSheet.Shapes("SCOTS_WIZARD").Fill.UserPicture _
"G:\Users\ScotLouis\Documents\My Spreadsheets\WordFind Wizard\WordFind Wizard 2.jpg"
So I've accomplished my goal of only having 1 picture per sheet (not 5 as in my animation) and duplicating the sheet only duplicates the active picture, so the animation continues seamlessly with the next picture.
![Please find attached code.
First create a shape in PPT and run the code]1
Is there a way to use Excel-VBA code in order to make a picture object in a sheet, so as to insert it as a footer image. I have tried to do so by creating a chart object and pasting it in a picture-format, and then exporting the chart to an image file and setting the image as the footer. Is there a better way to insert a picture object as a footer image, and if so, how do I do it?
I started the macro recorder. I clicked Page Setup then Header/Footer then Custom Footer. I clicked the centre section and then Format Picture (button with image of sun over mountains). I browsed for an image and clicked Insert. "&[Picture]" appeared in the centre section. I clicked OK twice. I switched the macro recorder off.
I printed the page and the selected image appeared at the bottom.
The important code saved by the macro recorder was:
ActiveSheet.PageSetup.CenterFooterPicture.Filename = _
"C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg"
Replace "C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg" with filename of your choice.
The macro recorder is usually the easiest way of discovering statements like this.
For anybody viewing this in the future, I'll share my code to copy a range and save it as a file on your computer, which can then be added to the footer. You can eliminate whatever bits you don't want =)
Dim objPic As Shape
Dim objChart As Chart
Dim strTimeStamp As String
Dim strFileDest As String
20 Sheets(2).Activate
30 Sheets(2).Columns("R:T").AutoFit
40 Sheets(2).Rows("17:21").AutoFit
50 ActiveWindow.DisplayGridlines = False
60 Call Sheets(2).Range("S17", "U21").CopyPicture(xlScreen, xlPicture)
70 ActiveWindow.DisplayGridlines = True
80 Sheets(2).Shapes.AddChart
90 Sheets(2).Activate
100 Sheets(2).Shapes.Item(1).Select
110 Set objChart = ActiveChart
120 ActiveChart.Parent.Name = "FooterChart"
' For some reason, Excel occasionally tries to make an actual chart out of these strings.
' It's just a nonsensical chart that messes the footer up but I'm having trouble duplicating the issue and figuring out what causes it.
' This should always work. Don't use .Clear, it crashes.
130 ActiveChart.ChartArea.ClearContents
140 objChart.Paste
150 Selection.Name = "FooterImage"
160 ActiveSheet.ChartObjects("FooterChart").Activate
170 Sheets(2).Shapes.Item(1).Line.Visible = msoFalse
180 Sheets(2).Shapes.Item(1).Height = Range("S17", "U21").Height
190 Sheets(2).Shapes.Item(1).Width = Range("S17", "U21").Width
200 ActiveChart.Shapes.Range(Array("FooterImage")).Height = Range("S17", "U21").Height
210 ActiveChart.Shapes.Range(Array("FooterImage")).Width = Range("S17", "U21").Width
220 Sheets(2).Shapes.Item(1).Height = Sheets(2).Shapes.Item(1).Height * 1.25
230 Sheets(2).Shapes.Item(1).Width = Sheets(2).Shapes.Item(1).Width * 1.25
240 ActiveChart.Shapes.Range(Array("FooterImage")).Height = ActiveChart.Shapes.Range(Array("FooterImage")).Height * 1.2
250 ActiveChart.Shapes.Range(Array("FooterImage")).Width = ActiveChart.Shapes.Range(Array("FooterImage")).Width * 1.2
260 strTimeStamp = CStr(Format(Now(), "yyyymmddHhNnSs"))
270 strFileDest = "D:\Temp" & strTimeStamp & ".jpg"
280 objChart.Export strFileDest
290 InsertPicture strFileDest
300 If Len(Dir$(strFileDest)) > 0 Then
310 Kill strFileDest
320 End If
330 Sheets(2).Shapes.Item(1).Delete
Try this:
Dim ws as Worksheet
Set ws = Worksheets("YourWorksheetName")
With ws.PageSetup
.CenterFooterPicture = "&G" 'Specifies that you want an image in your footer
.CenterFooterPicture.Filename = "C:\Pictures\MyFooterImage.jpg" 'specifies the image file you want to use
End With
The code generated by the macro recorder will get you part of the way there, but as is often the case, it doesn't provide the whole or most appropriate solution. It also sounds like you are trying to insert an image generated by Excel (such as a chart) into the footer? if that's the case, I believe you will have to same the object as an image and then reference that image file.