I have shape named pic, I fill the shape with picture via VBA code, I want vba line to load the same pic into userform1 image1 once the userform load
I am using this code to fill image into the shape, just need the part ( userform1.image1.picture=ActiveDocument.Shapes("pic").UserPicture )
Dim oDialog As Word.Dialog
Dim strName As String
Set oDialog = Dialogs(wdDialogInsertPicture)
With oDialog
.Display
'Insert Shape Picture if the Name property (Filepath) <> ""
If .Name <> "" Then
With ActiveDocument.Shapes("pic").Fill
.Visible = msoTrue
.UserPicture oDialog.Name ' <<<<<<<<<<<<<<<<<
End With
UserForm1.Image1.Picture = LoadPicture(oDialog.Name)
End If
End With
' Clean up
Set oDialog = Nothing
You need to save the picture on the drive to be able to set it to the form controls. The LoadPicture expects a full file path.
Related
Hello :) what I want to do is to have a Master document (PowerPoint) to use as template and personalize with graphics that are in another PowerPoint presentation. The master document on the code is "pre". The PowerPoint with the graphics is "graphs_pre". The idea is to click in a image on a slide of "pre" and a input box appears asking "Please enter the name of the graph", we write the name of the graph, the code opens the "graphs_pre" search for the graph with the same name and copy and paste on the "pre". This isn't working, always giving a lot of errors. So I need your help please. Please bare in mind that I have zero experience in coding...
Code:
Sub test()
Dim vSlide As Slide
Dim vSlide As Slides
Dim vShape As Shape
Dim vShapes As Shapes
Dim pre As Presentation
Dim graphs_pre As Presentation
Set pre = ActivePresentation
Set graphs_pre = Presentations.Open ("path of the graph presentation", msoFalse)
strResult = InputBox ("Please enter the name of the graph")
Set vShapes = Presentations(Dir("path of graph presentation").Slides.Shapes
For each vShape in vShapes
If strResult = vShape.Name Then
vShape.Copy
pre.Slides.Paste
End If
Next vShape
End Sub
Let's see if this (air code) gets you a little closer:
Sub test()
Dim vSlide As Slide
'Dim vSlide As Slides
Dim vSlides as Slides
Dim vShape As Shape
Dim vShapes As Shapes
Dim pre As Presentation
Dim graphs_pre As Presentation
' You use this later w/o DIMming it so add this
Dim strResult as String
Set pre = ActivePresentation
Set graphs_pre = Presentations.Open ("path of the graph presentation", msoFalse)
strResult = InputBox ("Please enter the name of the graph")
' I don't understand what this is supposed to do
' Set vShapes = Presentations(Dir("path of graph presentation").Slides.Shapes
' but I THINK you need to do this:
For each vSlide in graphs_pre.Slides
For each vShape in vSlide.Shapes
If strResult = vShape.Name Then
vShape.Copy
' This will paste onto the first slide in pre for now
' Which slide do you really WANT it on?
pre.Slides(1)Shapes.Paste
End If
Next ' vShape
Next ' vSlide
End Sub
And once you're all done, you'll want to do graphs_pre.Close
I'm currently trying to write a VBA macro for MS Word. The job is to iterate over selected cells of a table and to replace the filepath written there with the picture it points to.
The macro works fine when only one cell is selected or if all selected cells are in the same column. However, when cells from more than one columns are selected, only the left most column gets processed.
Here is the code:
Dim photoCells As Cells
Set photoCells = Selection.Cells
For Each photoCell In photoCells
Dim filePath As String
filePath = photoCell.Range.Text
filePath = Left(filePath, Len(filePath) - 2)
photoCell.Range.Text = ""
Dim shape
Set shape = photoCell.Range.InlineShapes.AddPicture(filePath)
With shape
.LockAspectRatio = msoTrue
.Width = photoCell.PreferredWidth
End With
Next
MsgBox "Completed."
End Sub
Interesting: When I do that:
For Each mCell in Selection.Cells
MsgBox mCell.Range.Text
Next
... it iterates over every cell in the selection.
Can anyone tell me where I messed things up? :-D
Thanks in advance!
Please, try the next way:
Sub InsertPictures()
Dim photoCells As Cells, photoCell, arrPh() As Cell, i As Long
Dim filePath As String, shape As InlineShape
Set photoCells = Selection.Cells
ReDim arrPh(1 To photoCells.Count)
For i = 1 To photoCells.Count 'place selected cells in a cells array
Set arrPh(i) = photoCells(i)
Next
For i = 1 To UBound(arrPh) 'iterate between the array cell elements
filePath = arrPh(i).Range.Text
filePath = Left(filePath, Len(filePath) - 2)
If Dir(filePath) <> "" Then 'check if file path exists
arrPh(i).Range.Text = ""
With arrPh(i).Range.InlineShapes.AddPicture(filePath)
.LockAspectRatio = msoTrue
.Width = arrPh(i).PreferredWidth
End With
End If
Next i
MsgBox "Completed."
End Sub
Given is the path of a picture. How can I add the picture to a word document by using VBA code?
This is the concept of adding image to word document.
Create a template document ,let say in c:\path\file.docx
add an image where ever you like (this will be the frame to hold the new image )
select the image and insert a bookmark and name it something like "someBookmarkName".
And now from access use this code
Sub insertImageToWord()
Dim Word As Object
Dim doc As Object
Dim filePath As String: filePath = "c:\path\file.docx"
Dim SHP As Object
Dim strTmp As String: strTmp = "someBookmarkName"
Dim strPath As String: strPath = "c:\path\image_file.png"
Set Word = CreateObject("Word.Application")
Set doc = Word.Documents.Open(filePath)
Set SHP = doc.Bookmarks(strTmp).Range.InlineShapes.AddPicture(Filename:=strPath, _
LinkToFile:=False, _
SaveWithDocument:=True)
With SHP
'this will keep ratio
' .WrapFormat.type = 1 'wdWrapTight
' .WrapFormat.type = 7 'wdWrapInline
.LockAspectRatio = -1 ' msoTrue
'this will adjust width to 0.5 inch
'.Width = wd.InchesToPoints(2.5)
' .Width = wd.CentimetersToPoints(2.66) * 2.5
' .Height = wd.CentimetersToPoints(3.27) * 2.5
' .ScaleHeight = 150
End With
End Sub
I am wanting to open an existing PowerPoint template and select slide 3 and copy a table from my spreadsheet to the PowerPoint slide.
Please can someone show me how to do this?
Sub Open_PowerPoint_Presentation()
'Opens a PowerPoint Document from Excel
Dim objPPT As Object
Dim PPSlide As Object
Set objPPT = CreateObject("PowerPoint.Application")
Set PPSlide = objPPT.Slides(5)
objPPT.Visible = True
'Change the directory path and file name to the location
'of your document
objPPT.Presentations.Open "\\MI-FILESERVE1\Shared Folders\Shared_Business_Dev\assets\Tender Time Allocation Deck.pptx"
PPSlide.Select
End Sub
Be CAREFUL : You cannot paste in the Shapes of your Slide if the collection is empty
I.E. : you'll need a slide with at least a title or a shape (square, triangle, ...) to be able to paste what you have copied in your clipboard.
Here are the basics, you should correct the excel lines to copy what you want :
Sub Open_PowerPoint_Presentation()
Dim objPPT As Object, _
PPTPrez As PowerPoint.Presentation, _
pSlide As PowerPoint.Slide
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set PPTPrez = objPPT.Presentations.Open("\\MI-FILESERVE1\Shared Folders\Shared_Business_Dev\assets\Tender Time Allocation Deck.pptx")
Set pSlide = PPTPrez.Slides(5)
If pSlide.Shapes.Count <> 0 Then
'Table
ActiveWorkbook.Sheets("Sheet1").Range("Named Range").Copy
pSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
'OR
ActiveWorkbook.Sheets("Sheet1").Range("Named Range").CopyPicture
pSlide.Shapes.Paste
'Charts
ActiveWorkbook.Sheets("Graph1").ActiveChart.ChartArea.Copy
pSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
'OR
ActiveWorkbook.Sheets("Graph1").ActiveChart.ChartArea.CopyPicture
pSlide.Shapes.Paste
Else
MsgBox "There is no shape in this Slide (" & pSlide.SlideIndex & ")." & vbCrLf & "Please use a slide with at least one shape, not a blank slide", vbCritical + vbOKOnly
End If
End Sub
I am used to doing this type of thing in Word, but the methods for the same sort of thing in PowerPoint are quite different.
I have a network folder with a list of text files in it. I want to be able to click into a text field on a slide and then click an import button on a custom menu. I then select one of the text files in the dialog and that imports the text into the area I have specified.
I have built the custom menu in PowerPoint 2010, and added a few other macros, but I can't work out the methods to use.
Can anyone give me a start?
Here is the code I am playing with:
Sub GetTextFromLibrary()
Dim lCurrentView As Long
Dim SlideNum As Integer
Dim Name$
Dim OldName$
'Store the default shape name to reset later
OldName$ = ActiveWindow.Selection.ShapeRange(1).Name
'Now rename the shape to work with it
Name$ = "temp01"
MsgBox "You are on slide: " & _
OldName$, vbInformation
ActiveWindow.Selection.ShapeRange(1).Name = Name$
' Get the current view type.
lCurrentView = ActiveWindow.ViewType
' Make sure that PowerPoint is in Slide view.
' ActiveWindow.Selection.SlideRange.SlideNumber produces an error if
' you are using any other view.
If lCurrentView = ppViewNormal Then
' Display the slide number.
'MsgBox "You are on slide: " & _
ActiveWindow.Selection.SlideRange.SlideNumber, vbInformation
SlideNum = ActiveWindow.Selection.SlideRange.SlideNumber
MsgBox "You are on slide: " & _
SlideNum, vbInformation
' Dim a variable as a specific object type
Dim oShape As Shape
' Set it to "point" to a specific shape:
Set oShape = ActivePresentation.Slides(SlideNum).Shapes("temp01")
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Declare a variable for the directory path.
Dim directory As String
'Set the directory path
directory = "C:\Documents and Settings\<USER>\Desktop\PitchTemplateLibrary\Quotes"
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Change the initial directory\filename
.InitialFileName = directory
'Use the Show method to display the File Picker dialog box and return the user's action.
'The user pressed the button.
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
Dim fs As Object
Dim f As Object
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(vrtSelectedItem, 1, 0)
' Put the text into the text box
oShape.TextFrame.TextRange.Text = f 'oShape IS EMPTY, BUT CAN"T SEE WHY.
Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With
' Until we release the memory used by oShape
Set oShape = Nothing
ActiveWindow.Selection.ShapeRange(1).Name = OldName$
Else
' PowerPoint is not in slide view.
MsgBox "You must be in slide view to run this macro.", _
vbInformation
End If
'Set the object variable to Nothing.
Set fd = Nothing
End Sub
PowerPoint code to set the text of a TextBox, or other Shape, is:
ActivePresentation.Slides(1).Shapes(3).TextFrame.TextRange _
= "Hello there"
I want to be able to click into a text field on a slide and then click an import button on a custom menu. I then select one of the text files in the dialog and that imports the text into the area I have specified.
' CYA
If Not ActiveWindow.Selection.Type = ppSelectionText Then
MsgBox "Select some text first"
Exit Sub
End if
' You might also want to allow for the case where the user has
' selected a rectangle or other shape rather than a text range.
' You could add the text to the shape as well.
With ActiveWindow.Selection.TextRange
.TextFrame.Text = "Text you've read from the chosen file"
End With