Is there a way to save a single slide as a PNG image with VBA that does not use Slides(#).Export? I am trying to save the image directly to SharePoint but the export causes an error if I make the save location anywhere besides my machine. I know that saving directly to SharePoint as an image is possible since I can click through the save as menu, but I cant replicate with VBA.
Application.FileDialog(msoFileDialogSaveAs _
).InitialFileName = "https://home.thesite.com/sample"
intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
If intChoice <> 0 Then
sImagePath = Application.FileDialog(msoFileDialogSaveAs _
).SelectedItems(1)
Else
MsgBox "Action Cancelled"
Exit Sub
End If
CurSlide = ActiveWindow.Selection.SlideRange.SlideIndex
ActivePresentation.Slides(CurSlide).Export sImagePath, "PNG"
Turns out Export will work if the link is modified so instead of
"https://home.thesite.com/sample"
its
"\\home.thesite.com#SSL\DavWWWRoot\sample"
Related
I am really struggling and wondered if someone could help please? I am trying to set up a database with images which I have done and used the file path of my pictures. It works well and that is great, but the next step is to have a form that just displays the pictures from each record to act as a catalogue and then When you click on a particular picture in that form it opens up another form that contains all the records and goes directly to that specified record. We have managed to get it to work for the first picture and record but can't work out how to make it go to the next record for the next image. I am trying to use a multi line form for this and only have the picture visible. I am just using a basic code as I have only just started with VBA but I believe this may not work. Can someone please help advise me?
I have used the following code which was suggested online for working with pictures and then there are a couple of other vba code to add to it. I need to create a catalogue inventory but we want to click on the picture of the inventory item which then opens a form with all the detail. I have found a work around with using the continous form and transparent buttons which take you to the specific record but you can't seem to change the layout. Ideally I am looking to have a form with just the images in a grid style going across the page and not just a list going down the page...if that makes sense?
Option Compare Database
Option Explicit
Public Function DisplayImage(ctlImageControl As Control, strImagePath As Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlImageControl
If IsNull(strImagePath) Then
.Visible = False
strResult = "No image name specified."
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Visible = True
.Picture = strImagePath
strResult = "Image found and displayed."
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
I have created an Excel-Document with macros that my customer should fill out save pressing a button.
Under the button is just this macro:
Sub filesave()
Dim bFileSaveAs As Boolean
bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
End Sub
The problem is that as default option you get to save the document as macro enabled excel workbook.
How can do show as default non macro enabled excel format or not show the posibility to save the document as macro enabled document in oder to make sure that the macros will not be saved in the filled out copy of the document?
Some ideas about how the code should look like?
You can use GetSaveAsFilename to let the user choose a location and filename and then save with Workbook.SaveAs Method by choosing a file format from XlFileFormat Enumeration.
Public Sub SaveFileAs()
Dim FileToSave As Variant
FileToSave = Application.GetSaveAsFilename(fileFilter:="xlsx Files (*.xlsx), *.xlsx")
If FileToSave <> False Then
ActiveWorkbook.SaveAs Filename:=FileToSave, FileFormat:=xlOpenXMLWorkbook
Else
'user chose cancel
End If
End Sub
Using the Office 2010 suite, I have a PowerPoint presentation where all the charts are linked to an Excel workbook. In order to move the presentation and/or workbook to another directory, all the links must be updated to point to the new workbook location. To do so, I've written the following code which resides in a standard code module in PowerPoint:
Private Sub RedirectLinks()
Dim Source As String
Dim Dest As String
Dim Action As Integer
If InStr(1, ActivePresentation.Path, "Dev\") > 1 Then
Action = MsgBox("Changing pointers to PRODUCTION", vbOKCancel)
Source = "Dev\"
Dest = vbNull
Else
Action = MsgBox("Changing pointers to DEVELOPMENT", vbOKCancel)
Source = "Templates\"
Dest = "Dev\Templates\"
End If
If Action = vbOK Then
Dim SL As Slide
Dim SH As Shape
Dim Top As Double
Dim Left As Double
Dim Width As Double
Dim Height As Double
For Each SL In ActivePresentation.Slides
SL.Select
For Each SH In SL.Shapes
SH.Select
If SH.Type = msoLinkedOLEObject Then 'when we find a linked one
Top = SH.Top
Left = SH.Left
Width = SH.Width
Height = SH.Height
SH.LinkFormat.SourceFullName = Replace(SH.LinkFormat.SourceFullName, Source, Dest)
SH.Top = Top
SH.Left = Left
SH.Height = Height
SH.Width = Width
End If
Next
Next
End If
If InStr(1, Dest, "dev") > 0 Then
Action = MsgBox("About to OVER WRITE the Dev copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
Else
Action = MsgBox("About to OVER WRITE the PRODUCTION copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
End If
If Action = vbOK Then
ActivePresentation.SaveAs Replace(ActivePresentation.Path, Source, Dest) & ActivePresentation.Name
End If
End Sub
The code executes just fine, however, I frequently get this message box popping up from Excel when it is executing the SH.LinkFormat.SourceFullName = Replace(SH.LinkFormat.SourceFullName, Source, Dest) line.
Items of note:
The workbook in question is actually closed - I know that it's not open by anyone else (I'm the only one who usually uses it, and the other person who's in there isn't in the office this morning).
It claims the file is locked by 'another user' which is actually me. I can often get this warning by closing the workbook, then immediately reopening it. I don't know if it's a network latency issue (file resides on a server, not locally), or what, but after a few moments of using the workbook, I'll get the workbook is now available for read-write message.
I don't get this warning every time it tries to execute the line that sets the .SourceFullName. Sometimes I'll get it most times, sometimes I won't get it at all, sometimes I'll get it on occasion.
Despite my thoughts of network lag, it doesn't matter how quickly or slowly I debug through the code, I'll get this message at random times.
Flagging either new or old workbooks as Read-only at the OS level does not seem to improve the situation.
However, flagging both seems to get me 2 warnings for each replacement line execution.
Does anyone have any suggestions on how to resolve this?
I've run into odd behaviors when code in PPT opens a PPTM and my Macro security settings are anything tighter than "Open any fool thing". Try dialing your macros security in PPT and Excel as low as they'll go, just as a test, and see if that eliminates the problem.
If anyone knows of a way to set the security options on the fly and reset them after, that'd be even better. It might be possible to do that via the registry prior to doing anything that'd invoke XL.
How can one find a only content (i.e. text) differences between two powerpoint files?
I use PPT 2013. It has a compare tool, but that also finds all text box movements, animation changes, formatting differences etc., which makes it difficult to see whether there are any text changes.
I need to compare "text only" and display any change in text
Context
My client gives me a PPT file. I will format it (color, font, animation etc.), but I'm not supposed to change any text content. If I delete or insert any content by mistake, I'd like to be able to detect that, so I can revert it.
In PowerPoint 2013 you can export the PowerPoint file content to word or a pdf file which you can then use to compare only the text changes:
choose File> Export, Create Handouts, then click
the Create Handouts button.
In the dialog box that opens, choose the Outline Only option and
click OK. Word opens with your text.
Update:
You can run this VBS script to extract the text to a text file then you can compare the two files.
It comes from the tool Beyond Compare 4 which can be downloaded as a trial edition. Download the Additional File Formats for PowerPoint files as well if you just want to compare the text changes from the tool.
' PPT_to_TXT.vbs
'
' Extracts plain text from a PowerPoint document. Requires Microsoft PowerPoint.
' Usage:
' WScript PPT_to_TXT.vbs <input file> <output file>
Option Explicit
' MsoAutomationSecurity
Const msoAutomationSecurityForceDisable = 3
' OpenTextFile iomode
Const ForAppending = 8
Dim App, AutoSec, Doc, FileSys
Set FileSys = CreateObject("Scripting.FileSystemObject")
If FileSys.FileExists(WScript.Arguments(1)) Then
FileSys.DeleteFile WScript.Arguments(1)
End If
Set App = CreateObject("Powerpoint.Application")
On Error Resume Next
App.DisplayAlerts = False
AutoSec = App.AutomationSecurity
App.AutomationSecurity = msoAutomationSecurityForceDisable
Err.Clear
Dim Comment, Shape, Slide, TgtFile
Set Doc = App.Presentations.Open(WScript.Arguments(0), True, , False)
If Err = 0 Then
Set TgtFile = FileSys.OpenTextFile(WScript.Arguments(1), ForAppending, True)
For Each Slide In Doc.Slides
For Each Shape In Slide.Shapes
If Shape.HasTextFrame Then
If Shape.TextFrame.HasText Then
TgtFile.WriteLine Shape.TextFrame.TextRange.Text
End If
End If
Next
For Each Shape In Slide.NotesPage.Shapes
If Shape.HasTextFrame Then
If Shape.TextFrame.HasText Then
TgtFile.WriteLine Shape.TextFrame.TextRange.Text
End If
End If
Next
For Each Comment In Slide.Comments
TgtFile.WriteLine Comment.Author & vbTAB & Comment.DateTime & vbTAB & Comment.Text
Next
Next
TgtFile.Close
Doc.Close
End If
App.AutomationSecurity = AutoSec
App.Quit
I have a very large and complex PowerPoint with a full size image as the background for every individual slide. I have a directory full of these background pictures, which are all JPEG's. Sometimes I change these photographs, which are made with Photoshop, and when I change them, I save them over the original JPEG in the same directory.
I then have to update them in the PowerPoint. The manual functios to do this is to right-click the photograph, and click replace photo, then pick the new JPEG from the file menu. I want to write a macro in Visual Basic that will go through the entire slideshow, and reload the graphic from the updated JPEGs, without me having to do it manually. I don't know if it is possible, because I don't know if PowerPoint actually remembers the path and filename of each picture that it places.
Is there a picture property which contains the path and filename that was used to paste the picture in the first place? If there is, I could find that property, query it, and use that as the path to reload and thereby update the picture recursively all the way through slide by slide.
Would this be possible?
Is there a picture property which contains the path and filename that was used to paste the picture in the first place?
Not that I'm aware of, but you can create your own, using the Tags property:
http://msdn.microsoft.com/en-us/library/office/ff744290(v=office.15).aspx
You will have to assign a custom tag for each slide, like:
Sub AssignTag()
Dim sld as Slide
Set sld = ActivePresentation.Slides(1)
sld.Tags.Add "img_location", "C:\files\image1.JPG"
End Sub
Once the slide's Tags have been configured, then you can do something like this to update from that location:
Sub UpdateJPGs()
Dim sld As Slide
Dim path As String
For Each sld In ActivePresentation.Slides
path = sld.Tags("img_location")
If Not path = vbNullString Then
On Error Resume Next
sld.Background.Fill.UserPicture path
If Err Then
MsgBox "Unable to update slide #" & sld.SlideNumber
Err.Clear
End If
On Error GoTo 0
End If
Next
End Sub