Copy Range Values to VBA

Not sure how useful this is, but sometimes I need to fill in a spreadsheet with some default values. So I wrote this code to take a spreadsheet I manually filled out and write the code needed to put those values back into a spreadsheet. This just loops through all the selected cells and makes VBA code for building those values back:

Function CodeRangeInVBA(TheRange As Range) As String

Dim Result As String

Dim Cr As Range

For Each Cr In TheRange

If Result <> "" Then Result = Result & Chr(10)

Result = Result & "Range(" & Chr(34) & Cr.AddressLocal & Chr(34) & ").Value = " & Chr(34) & CStr(Cr.Value) & Chr(34)

Next Cr

CodeRangeInVBA = Result

End Function

Replacing Videos in a Presentation with Images

I'm not sure how often anyone runs into this, but I know when I have to convert PowerPoint presentations to Flash, I've had issues with how slides with embedded videos display. So a while back I wrote a little addin that goes through a presentation and removes any videos, replacing them with images of the video.

I'm making it available because maybe someone else needs the same kind of thing.

Get it here.

Powerpoint 2003 Replace Image

So Powerpoint 2007 has a nice easy right-click option on an image to choose a new image file and keep everything else unchanged (especially animations). Unfortunately, those still using 2003 are pretty much SOL, at least without using VBA.

So here's some VBA for doing this. You'll have to set up a UI, and pass in the shape to use (get selected shape using: ActiveWindow.Selection.ShapeRange(1) ). So basically the code looks at the passed in shape, creates a new shape, copies all the properties from the old shape to the new, and deletes the old shape.

Function UpdateImage_BuildNewFromFile(TheImage As PowerPoint.Shape, ImageFile As String) As Boolean

' Create a new shape and add the image (unlinked) from TheImage, copy attributes and size, position, etc...

UpdateImage_BuildNewFromFile = True

On Error Resume Next

'On Error GoTo PROC_ERR

If TheImage Is Nothing Then GoTo PROC_ERR_BELOW

If ImageFile = "" Then GoTo PROC_ERR_BELOW

If Not TypeOf TheImage.Parent Is Slide Then GoTo PROC_ERR_BELOW

Dim TheSlide As PowerPoint.Slide

Set TheSlide = TheImage.Parent

Dim NewShape As PowerPoint.Shape

Set NewShape = TheSlide.Shapes.AddPicture(ImageFile, msoFalse, msoTrue, 100, 100)

With NewShape

With .PictureFormat

.CropBottom = TheImage.PictureFormat.CropBottom

.CropLeft = TheImage.PictureFormat.CropLeft

.CropRight = TheImage.PictureFormat.CropRight

.CropTop = TheImage.PictureFormat.CropTop

.Brightness = TheImage.PictureFormat.Brightness

.ColorType = TheImage.PictureFormat.ColorType

.Contrast = TheImage.PictureFormat.Contrast

.TransparentBackground = TheImage.PictureFormat.TransparentBackground

End With

.Left = TheImage.Left

.Top = TheImage.Top

.Width = TheImage.Width

.Height = TheImage.Height

SetZPosition NewShape, TheImage.ZOrderPosition

With .AnimationSettings

.AdvanceMode = TheImage.AnimationSettings.AdvanceMode

.AdvanceTime = TheImage.AnimationSettings.AdvanceTime

.AfterEffect = TheImage.AnimationSettings.AfterEffect

.Animate = TheImage.AnimationSettings.Animate

.AnimateBackground = TheImage.AnimationSettings.AnimateBackground

.AnimateTextInReverse = TheImage.AnimationSettings.AnimateTextInReverse

.AnimationOrder = TheImage.AnimationSettings.AnimationOrder

.ChartUnitEffect = TheImage.AnimationSettings.ChartUnitEffect

.DimColor = TheImage.AnimationSettings.DimColor

.EntryEffect = TheImage.AnimationSettings.EntryEffect

With .PlaySettings

.ActionVerb = TheImage.AnimationSettings.PlaySettings.ActionVerb

.HideWhileNotPlaying = TheImage.AnimationSettings.PlaySettings.HideWhileNotPlaying

.LoopUntilStopped = TheImage.AnimationSettings.PlaySettings.LoopUntilStopped

.PauseAnimation = TheImage.AnimationSettings.PlaySettings.PauseAnimation

.PlayOnEntry = TheImage.AnimationSettings.PlaySettings.PlayOnEntry

.RewindMovie = TheImage.AnimationSettings.PlaySettings.RewindMovie

.StopAfterSlides = TheImage.AnimationSettings.PlaySettings.StopAfterSlides

End With

.TextLevelEffect = TheImage.AnimationSettings.TextLevelEffect

.TextUnitEffect = TheImage.AnimationSettings.TextUnitEffect

End With

End With

PROC_EXIT:

If Not TheImage Is Nothing Then TheImage.Delete

On Error GoTo 0

Exit Function

PROC_ERR:

MsgBox Err.Description

UpdateImage_BuildNewFromFile = False

GoTo PROC_EXIT

PROC_ERR_BELOW:

UpdateImage_BuildNewFromFile = False

GoTo PROC_EXIT

End Function

Using MailTo: in a VBA macro

So yesterday I wrote a VBA macro where I wanted the end user to be able to send me some information generated by the tool the macro is a part of. I am pretty good at programming Outlook to do things for me using VBA, but I don't want to assume that's what the end user uses.

The alternative I came up with was using the mailto: command or link or whatever it is. It's the same thing you see in a web page when someone embeds their email address, you click it, and Windows pops up your default email editor with the author specified in the to: line. In a search I came up with this page that shows how you can not only specify the to: line, but also the subject and body. Perfect for what I want to do.

So all I had to do was make a VBA function to build a nice mailto: line based on input, and here's what I came up with:

Public Sub StartEmail(ToAddr As String, Optional Subject As String, Optional Body As String)
Dim URL As String
URL = "Mailto:" & ToAddr
If Subject <> "" Then
URL = URL & "?subject=" & Subject
If Body <> "" Then
URL = URL & "&body=" & Body
End If
ElseIf Body <> "" Then
URL = URL & "?body=" & Body
End If

Navigate URL
End Sub

The function simply takes in a mandatory to: argument, and optional subject and/or body, and builds a mailto: link like this.

The last link in this whole chain is calling the mailto: link so Windows can deal with it. I just call a sub I call navigate, which is really just calling the Windows ShellExecute API function. I just set it up in a separate module in pretty much any project I do because i usually end up using it for something, usually just letting Windows deal with opening a file or link, instead of me having to deal with it.

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal _
lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As _
Long

Private Const SW_SHOW = 1

Public Sub Navigate(ByVal NavTo As String)
Dim hBrowse As Long
hBrowse = ShellExecute(0&, "open", NavTo, "", "", SW_SHOW)
End Sub


So yeah, anyway, now I have a nice easy one-line call to open up an email with whatever I want filled in. To be honest I've only tried it on my work machine which has Outlook as the default mail app, so your mileage may vary with other apps.

Import a folder of pictures to PowerPoint slides

My father has a project he's doing for presentation to a local historical society. Part of this project appears to involve documenting a bunch of photos, and also presenting them. He asked me the other day to give him a tutorial on adding photos to PowerPoint slides, at which point he'd take about 120 photos and manually place them.

Thinking of doing anything manually in MS Office made me cringe a bit. So I offered to build him a VBA macro to place the photos for him, provided that he populate a folder with all the images he wanted, then he could hit a button, pick the folder, and get a PowerPoint presentation with all his pictures placed.

Anyone who's written VBA for PowerPoint could figure out how to do this in a trice, but here I've provided an unlocked PPT file with all the code you need.

It seems to work fine for me, and you can do what you want with it.

You can download it here.