I got a command button to insert and resize an image (company logo). When printing I want this command button to be hidden, but the logo has of course to be visible.
My problem is that if the command button is hidden, then the logo is hidden as well. I couldn't come up with a code that hides the command button while keeping the logo visible.
I have also tried using Toggle Field Codes but had the same problem... Any ideas?
Here's the code so far (which works well):
Dim oShp As Shape
'Select and insert the Pic
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then
Set oShp = ActiveDocument.Shapes.AddPicture( _
FileName:=.SelectedItems(1), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=5, _
Top:=12)
With oShp
.LockAspectRatio = msoCTrue
.Width = InchesToPoints(2)
End With
Else
End If
End With
Related
When using the Insert > Insert Pictures option directly in Word the Insert Picture dialog "All Pictures" File name dropdown filter contains the file extension .svg.
Insert Picture Dialog
When using VBA to display the dialog, the "All Pictures" File name dropdown filter does not contain the file extension .svg:
Set oDialog = Dialogs(wdDialogInsertPicture)
' Work with dialog
With oDialog
' Display the dialog
.Display
' Insert InlineShape if the Name property (Filepath) <> ""
If .Name <> "" Then
ActiveDocument.InlineShapes.AddPicture FileName:=.Name, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=Selection.Range
End If
End With
VBA Insert Picture Dialog
Is there a way to get the .svg file extension to display as part of the filter using the VBA Insert Picture Dialog?
This occurs in Microsoft Office 365 ProPlus Version 1908 (Build 11929.20562 Click-to-Run).
Here's some workaround code for you to try.
Sub InsertPicture()
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the image file to insert. Multiple selections not allowed."
.InitialFileName = "What Ever"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "All Pictures", "*.emf; *.wmf; *.jpg; *.jpeg; *.jfif; *.jpe; *.png; *.bmg; *.dib; *.rle; *.gif; *.emz; *.wmz; *.pcz; *.tif; *.tiff; *.svg; *.cgm; *.pct; *.pict; *.wpg", 1
If .Show = 0 Then
Exit Sub
End If
If .SelectedItems(1) <> "" Then
ActiveDocument.InlineShapes.AddPicture FileName:=.SelectedItems(1), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=Selection.Range
End If
End With
End Sub
The purpose of this code is to allow the end-use to put two pictures per page. It also has the purpose of putting the last 4 numbers of the photo as the caption minus the ".extension" (ie. .jpg). How do I remove the auto-numbering of the photos and remove the ".jpg" (extension) from the code below? I figured out how to turn off the Picture label.
Sub AddPic()
Dim fd As FileDialog
Dim oTbl As Table
Dim oILS As InlineShape
Dim vrtSelectedItem As Variant
Dim dotPos As Long
Dim lenName As Long
Dim capt As String
'''''''''''''''
'Add a 1 row 2 column table to take the images
'''''''''''''''
Set oTbl = Selection.Tables.Add(Selection.Range, 4, 1)
With oTbl
.AutoFitBehavior (wdAutoFitWindow)
End With
'''''''''''''''
Set fda = Application.FileDialog(msoFileDialogFilePicker)
With fda
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then
CaptionLabels.Add Name:=" "
For Each vrtSelectedItem In .SelectedItems
dotPos = InStr(vrtSelectedItem, ".")
lenName = Len(vrtSelectedItem)
capt = Mid(vrtSelectedItem, lenName + (dotPos - 4 - lenName))
With Selection
Set oILS = .InlineShapes.AddPicture(FileName:= _
vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)
oILS.Range.InsertCaption Label:=" ", Title:=capt, _
Position:=wdCaptionPositionBelow, ExcludeLabel:=0
.MoveRight wdCell, 1
End With
Next vrtSelectedItem
If Len(oTbl.Rows.Last.Cells(1).Range) = 2 Then oTbl.Rows.Last.Delete
Set fd = Nothing
End If
End With
'''''''''''''''
For Each pic In ActiveDocument.InlineShapes
With pic
.LockAspectRatio = msoFalse
If .Width > .Height Then ' horizontal
.Width = InchesToPoints(5.5)
.Height = InchesToPoints(3.66)
Else ' vertical
.Width = InchesToPoints(5.5)
End If
End With
Next
'''''''''''''''
Selection.WholeStory
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle
Selection.Font.Color = wdColorBlack
'''''''''''''''
End Sub
The more elegant way is to work with Range objects, such as used in the Answer to your other question. But since you appear to be more comfortable with Selection, I've used that in the code snippet below.
If neither numbering nor a caption label is wanted, it makes no sense to use the InsertCaption functionality, which specifically does those things. Instead, simply insert the text at the desired position (below the picture).
The code does this by selecting the picture, moving one character to the right (pressing the right-arrow key) then inserting the text. Note that the first character is a paragraph mark (pressing Enter), then the caption.
The "last 4 numbers of the photo" - I assume "file name" is meant - can be done by limiting the string Mid returns to four characters. (See the , 4 added to it.)
For Each vrtSelectedItem In .SelectedItems
dotPos = InStr(vrtSelectedItem, ".")
lenName = Len(vrtSelectedItem)
capt = Mid(vrtSelectedItem, lenName + (dotPos - 4 - lenName), 4)
With Selection
Set pic = .InlineShapes.AddPicture(fileName:= _
vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)
pic.Range.Select
.MoveRight wdCharacter
Selection.Text = vbCr & capt
.MoveRight wdCell, 1
End With
Next vrtSelectedItem
I think this could solve problems for a lot of people doing tedious pasting of images from one directory into powerpoint then resizing them.
My problem is that I have 16 images all in one directory which need updating each month and it's very slow to do it one by one. The task is:
Open directory
Open first image
Paste image into powerpoint
Reposition image to top left
Resize image to height 550 by width 960 (fills A4 page)
Send image to back
Move to next slide
Repeat for second image
Continue until no more images in directory
Directory is (e.g.) "C:\Users\xxxxxx\Documents\Work\Procurement Project\Slides"
First image name is (e.g.) "01 Summary", second is "02 Client Contracts" etc etc
I think I need a str and a path and a table for the str to add to path to create each new path using i and i + 1 etc
I think I then need some code that's a bit like this:
Sub Picture_size_and_position()
Dim oShape As Shape
Dim oPresentation As Presentation
Dim oSlide As Slide
Dim oSelection As Selection
ActiveWindow.View.GotoSlide oSlide.SlideIndex
With ActiveWindow.Selection.ShapeRange
.LockAspectRatio = msoFalse
.Height = 550
.Width = 960
.Left = 0
.Top = 0
End With
End Sub
Then I'm sure I need a looping function to repeat this until there's nothing left in the directory using some combination of i and j...but the whole code is way beyond me, very frustratingly.
Could someone offer some tips, please? Much much appreciated!
Thank you!
Sub ImportABunch()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
' Edit these to suit:
strPath = "C:\Users\username\"
strFileSpec = "*.png"
strTemp = Dir(strPath & strFileSpec)
i = 1
Do While strTemp <> ""
Set oSld = ActivePresentation.Slides(i)
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=960, _
Height:=550)
i = i + 1
With oPic
.LockAspectRatio = msoFalse
.ZOrder msoSendToBack
End With
' Or (with thanks to David Marcovitz) make the picture as big as possible on the slide
' without changing the proportions
' Leave the above commented out, uncomment this instead:
' With oPic
' If 3 * .width > 4 * .height Then
' .width = ActivePresentation.PageSetup.Slidewidth
' .Top = 0.5 * (ActivePresentation.PageSetup.Slideheight - .height)
' Else
' .height = ActivePresentation.PageSetup.Slideheight
' .Left = 0.5 * (ActivePresentation.PageSetup.Slidewidth - .width)
' End If
' End With
' Optionally, add the full path of the picture to the image as a tag:
'With oPic
' .Tags.Add "OriginalPath", strPath & strTemp
'End With
' Get the next file that meets the spec and go round again
strTemp = Dir
Loop
End Sub
Credit to http://www.pptfaq.com/index.html - Great little site!
Have an idea to automate it/or upon manual launch of a new Macro Enabled PowerPoint Template file. To automate macro upon file open, add customUI: onLoad="ImagesToPowerPoint". Search "CustomUI Editor" for it.
Note I have not fully tested the automation part.
Option Explicit
Sub ImagesToPowerPoint()
Const FileType As String = "*.png"
Dim sSaveFilePath As String, sSaveFileName As String, sImagesFolder As String
Dim oLayout As CustomLayout, oSlide As Slide, i As Long, sFile As String
sImagesFolder = Environ("USERPROFILE") & "\Documents\Work\Procurement Project\Slides\"
' Prepare auto save PowerPoint file name
sSaveFilePath = Environ("USERPROFILE") & "\Documents\Work\PowerPoints\"
sSaveFileName = Format(Now, "yyyy_mmdd") & "_Procurement.pptx"
With ActivePresentation
' Use the first layout for all new slides
Set oLayout = .SlideMaster.CustomLayouts(1)
' Start processing all files in the folder
sFile = Dir(sImagesFolder & FileType)
Do Until sFile = ""
' Add new slide
Set oSlide = .Slides.AddSlide(.Slides.Count, oLayout)
' Delete all the shapes from that layout
For i = oSlide.Shapes.Count To 1 Step -1
oSlide.Shapes(i).Delete
Next
' Add the image to slide
With oSlide.Shapes.AddPicture(sImagesFolder & sFile, msoFalse, msoTrue, 0, 0, oLayout.Width, oLayout.Height)
.LockAspectRatio = msoFalse
.AlternativeText = Now & " | " & sImagesFolder & sFile
End With
sFile = Dir
Loop
.SaveAs sSaveFilePath & sSaveFileName
End With
Presentations(sSaveFileName).Close
If Presentations.Count = 0 Then Application.Quit
End Sub
I'm working with word, Office 2010 and I have this macro that inserts a text box with the text "ABC".
Sub AddATextBox()
Dim Box As Shape
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=20, Top:=780, Width:=100, Height:=100)
With Box
.TextFrame.TextRange.Text = "ABC"
.Line.Visible = msoFalse
Box.TextFrame.TextRange.Font.Name = "Arial"
Box.TextFrame.TextRange.Font.Size = 6
End With
End Sub
Instead of the text "ABC", I would like this macro to insert into the text box the field "file name". Preferably without the file extension, but if it's complicated then I can live with it.
How can it be done? Thanks
The code below will insert a textbox at the bottom of the page and write the active document's name into it. Note that the shape isn't part of the footer. It is anchored in the main document body.
Sub InsertATextBox()
Dim Box As Shape
Dim Sp() As String
Debug.Print ActiveDocument.Name
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=20, Top:=780, Width:=120, Height:=12)
Sp = Split(ActiveDocument.Name, ".")
ReDim Preserve Sp(UBound(Sp) - 1)
With Box
With .TextFrame.TextRange
.Text = Join(Sp, ".")
.Font.Name = "Arial"
.Font.Size = 6
End With
.Line.Visible = msoFalse
End With
End Sub
I have been adding a range of buttons to a customUi menu in Word. One of the buttons imports one or more images form a library folder on a server, but I can't get it to put a paragraph return between each image when it adds them to the page.
With fd
.InitialFileName = strFolder & "\*.png; *.jpg; *.gif"
.ButtonName = "Insert"
.AllowMultiSelect = True ' Make multiple selection
.Title = "Choose one or more pictures from the library"
.InitialView = msoFileDialogViewPreview
'Sets the initial file filter to number 2.
' .FilterIndex = 2
'Use the Show method to display the File Picker dialog box and return the user's action.
'If the user presses the action button...
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is a String that contains the path of each selected item.
Selection.InlineShapes.AddPicture FileName:= _
vrtSelectedItem _
, LinkToFile:=False, SaveWithDocument:=True
Next vrtSelectedItem
I've tried adding a paragraph line [Selection.TypeParagraph] at various places, but it just adds the return after all of the images.
Any help would be appreciated.
did you try to use:
Selection.InsertParagraphAfter
Selection.Move
which is possibly what you are looking for??
Add the line before Next statement.