Update PowerPoint pictures using VBA - image

My day to day work involves creating powerpoints for clients highlighting their campaign performance. Most of the charts have been linked to excel, which saves me a ton of time but I end up spending time updating the images in the powerpoint.
In order to preserve the size and postion of images, i use the change picture option when you right select the picture and paste in the link like this: https://fbcdn-sphotos-c-a.akamaihd.net/hphotos-ak-snc6/9943_10151547582895095_1006500471_n.jpg. All the links are ordered in excel which is given by the client.
I have already gone through a similar post here: Using VBA to insert/update image in PowerPoint?, but i was looking for a solution where the pictures get updated based on the links in excel. Any help here would be appreciated.

I found the answer at a different website. Posting it here in case anyone else is looking at solving the same challenge:
Sub recupererImageWeb_WinHttp()
'activate library : Microsoft WinHttp Services ,version 5.1
Dim b() As Byte
Dim h As Long
Dim oWinHttp1 As WinHttp.WinHttpRequest
Dim dex As String
dex = Worksheets("Sheet1").Cells(2, 11).Value
h = FreeFile
Open "C:\AAAA - Report\WWWWorkflow\cover.jpg" For Binary As #h
Set oWinHttp1 = New WinHttp.WinHttpRequest
oWinHttp1.Open "GET", _
dex, False
oWinHttp1.Send
oWinHttp1.WaitForResponse (30)
b() = oWinHttp1.ResponseBody
Set oWinHttp1 = Nothing
Put #h, 1, b()
Close #h
End Sub

Related

compile error: method or data member not found in vb6

Hi all I am a php developer but since working in an organisation I got a work on a vb6 project.
The software is quite old let say atleast 10 year and I don't know vb6 at all. But still I manage to solve some errors but now I stuck on and I didn't get any solution. I have got this error when compiling the project, highlighting this code.
with .Panels(6) = selected.
Public Sub StatusBarDateTime()
'' FrmMain.Stb1.Panels(5) = Time
FrmMain.Stb1.Panels(6) = Format(Date, "dd-mmm-yyyy")
End Sub
and when I delete this line on code it show another error that
Compile error:
Sub or Function not defined
highlighting this line of codes
Private Sub MDIForm_Load()
StatusBarDateTime
End Sub
I assumed that it is declaring the function. so I delete this function also.
Now after deleting this when I compiled againg I got this error saying that
Run time error'481'
Invalid picture
and when I click on debug it shows this line of code
Private Sub Form_Load()
FrmMain.Show
Dim strUser As String
Call Center_Align(FrmLogin)
OpenConnection
strUser = "select * from TMUser order by login_name"
rsUser.Open strUser, conpgdhm, adOpenKeyset, adLockOptimistic
Set CmbUserID = rsUser
CmbUserID = "login_name"
CmbUserID = "login_id"
End Sub
highlihting Set CmbUserID = rsUser line. and now I got nothing.
I don't know how many error may I get after resolving this but that is the next part.
First I have to solve this. I have no idea how to resolve this.
I am banging my head around for two days now, If someone can help me please.
Thanks in advance.
Those were helpful....
The reason it's stopping there is because you are attempting to assign a datareader (or whatever object type rsUser is) as the value to a string or int type (CmbUserID)
You are trying to fit a whole bag of rectangles into a round whole. This is in reference to your latest error only. Based on what I see here, you lack the experience in VB6 to continue without some assistance. I suggest a consultant.
Hope this helps.

Need Assistance with VBSCRIPT to capture screenshots of user's desktop

I am a novice when it comes to object oriented program. That said, I have been trying to construct a vbscript that will capture a screenshot of the desktop and immediately save it to a folder I specify. Here is the code I have so far:
' START
Dim screenSize
screenSize = New screenSize.Size(Screen.PrimaryScreen.Bounds.X,Screen.PrimaryScreen.Bounds.Y)
Dim screenGrab
screenGrab = New screenGrab.Bitmap(My.Computer.Screen.Bounds.Width, my.Computer.Screen.Bounds.Height)
Dim g
g = g.System.Drawing.Graphics.FromImage(screenGrab)
dim copyS
copyS = Graphics.CopyPixels4.PaintEventArgs
dim copyS2
copyS2 = copyS.Graphics.CopyFromScreen(Screen.PrimaryScreen.Bounds.X, Screen.PrimaryScreen.Bounds.Y, 0, 0, Screen.PrimaryScreen.Bounds.Size, CopyPixelOperation)
dim saveTo
saveTo = screenGrab.Save("C:\temp\screenGrab.bmp")
' END
I prefer to keep this in VBSCRIPT as this script will be incorporated into an existing vbscript I created. I currently get an error at line 3 stating "class not defined 'screensize". I am also concerned that even if I fix the error at line 3 I may run into other syntax issues afterward. The overall intent of the script is to 1) get the screen dimensons ; 2) perform the screenshot ; 3) and save the file to a destination. I am open to any suggestions to make this work.
I appreciate any help I can get at this point. Thank you.
It seems like you have messed VB.NET with VBScript.
screenSize, screenGrab, System.Drawing.Graphics - there are no such classes in VBScript by default.
What I'd suggest is to use some screen capture ActiveX (google it).
Or create your own ActiveX with VB6 by using code like this. Create new ActiveX project in VB6, add that module and compile.
And remember to run regsvr32.exe youractivex.ocx before using it in your script.

VBA - Export individual PowerPoint slides into PDF files, named by content field

I have about 15 different slide decks, that contain 3-4 slides each. Each deck is comprised of "certificates" to be broken out and given to each individual recipient, who is named on the certificate. This process is repeated every month.
ideally, I would like to enable a VBA script to extract each sheet to save as (or print as) a PDF, and save the file with the name of the recipient named on the slide... is this possible?
The best I have found is this code, (which doesn't work on my mac, but works fine on a VM) which DOES separate the slides into PDF's, but I would like the naming to be changed.
Any help would be greatly appreciated!!
Sub ExportSlidesToIndividualPDF()
Dim oPPT As Presentation, oSlide As Slide
Dim sPath As String, sExt As String
Set oPPT = ActivePresentation
sPath = oPPT.FullName & "_Slide_"
sExt = ".pdf"
For Each oSlide In oPPT.Slides
i = oSlide.SlideNumber
oSlide.Select
oPPT.ExportAsFixedFormat _
Path:=sPath & i & sExt, _
FixedFormatType:=ppFixedFormatTypePDF, _
RangeType:=ppPrintSelection
Next
Set oPPT = Nothing
End Sub
Edit for further clarification:
I'm forced to run the script in my Windows Virtual Machine, and when I do that, I'm losing all of my formatting that I set up in my slides, created in office '11 (which is one of my big reasons to export to PDF in the first place).
A little more about my project:
1. I am compiling a couple thousand lines of "actions" (data), to determine a winner for a recognition award, based on criteria for 4 different award categories, for 12-15 different executives.
2. Results are tallied, then I retrieve the winners information (name, ID, and the same for their manager and executive) from an LDAP directory. Then put into a csv for mail-merge at later step.
3. A Template slide deck is used for all slides, (12-15 executives have 3-4 winners each).
4. Individual PDF certificates are created from those slides.
5. Congratulatory message is drafted, fields pulled from prepared csv for mail-merge, and then exported to outlook 2011 outbox (client offline).
6. I attach each individual certificate to each message manually in the outbox.
7. Send.
I have compiled sample set of the files linked here: Recognition Files (Sample)
On each slide there are one or several shapes. For the sake of illustration, assume that the recipient's name is in the first shape.
Sub ExportSlidesToIndividualPDF()
Dim oPPT As Presentation, oSlide As Slide
Dim sPath As String, sExt As String
Set oPPT = ActivePresentation
sExt = ".pdf"
For Each oSlide In oPPT.Slides
'## Retrieve the recipient's name from the shape and append it to the exported path:
sPath = oPPT.FullName & oSlide.Shapes(1).TextFrame.TextRange.Text
i = oSlide.SlideNumber
oSlide.Select
oPPT.ExportAsFixedFormat _
Path:=sPath & sExt, _
FixedFormatType:=ppFixedFormatTypePDF, _
RangeType:=ppPrintSelection
Next
Set oPPT = Nothing
End Sub
It may be more complicated, depending on how the slides are configured (e.g., if there is a shape that contains the name and other text, you will need a function to parse out the proper name and omit the rest, etc.
Provide more detail, about the problem if you need further assistance.

Reading files into a spreadsheet using VBA is very slow

I am using the following VBA code to import a rather large text file into a spreadsheet, however this seems to take ages. (Approximately 0.0064 seconds per cell, which quickly becomes too much when the files are substantially larger.) The file is simply stored locally so this could not be an issue.
My code currently looks like this:
Public Sub DataImport(fullFileName As String, worksheetName As String, cellName As String)
'Move to the sheet and desired first cell
ActiveWorkbook.Sheets(worksheetName).Activate
Range(cellName).Activate
Open fullFileName For Input As #1
' Copy the file into the excel sheet
row_number = 0
Do Until EOF(1)
Line Input #1, LineFromFile
LineItems = Split(LineFromFile, vbTab)
For i1 = LBound(LineItems) To UBound(LineItems)
ActiveCell.Offset(row_number, i1).Value = LineItems(i1)
On Error Resume Next
ActiveCell.Offset(row_number, i1).Value = ActiveCell.Offset(row_number, i1).Value * 1
Next i1
row_number = row_number + 1
Loop
Close #1
End Sub
EDIT: I am working on Office For Mac and the final product should work on both Windows and OS X.
All help on this is greatly appreciated!
Kind regards
The code in question works with active sheet with updates switched on (default). This means Excel has to redraw the screen and recalculate the sheet every time a cell is updated. Try disable updates during import with "Application.ScreenUpdating = False". The drawback is, that Excel becomes unresponsive during the update. Finally , turn the screen updating back on.

Save images in Outlook 2007

Programmatically, of course.
Having already asked this question on superuser, I'm looking at writing a simple macro to pull down the displayed image in an HTML message (email or feed) in outlook 2007, and allow me to save it to disk.
Unfortunately, I havent been able to find where in the OL object model I can reference either linked images, or the html content itself. Finding attached files is easy, its the linked/displayed images that is my issue.
Any help? Of course, if you have a better non-programmatic answer, I'll be glad to see that - over on superuser, of course...
This is based on the MSDN docs. I don't have Outlook to test it.
Assuming you have an email message open, you can call GetInspector method on the MailItem instance that you have & use its HTMLEditor property to get handle to the DOM.
From here on, you can call regular methods such as document.Images to get handle to all the image elements. I don't know, how one can save it locally to a disk but I am sure, there must be some method to do it.
I had a second look at shahkalpeshs answer and came up with the following solution:
(Written in Outlook 2003)
Option Explicit
Private Sub getImages()
Dim xmlhttp_ As xmlhttp
Dim htmldoc As Object
Dim currentImage As Object
Dim currentResponse() As Byte
Dim startTime As Date
Dim maxTime As Long
Dim pathFolder As String
Dim pathFull As String
Dim nrFile As Integer
pathFolder = "C:\YourFolder\Images\" '"(small fix for stackoverflow syntaxhighlighter)
maxTime = 30 ' max time to load 1 File in seconds '
If Me.ActiveWindow.CurrentItem.GetInspector.EditorType = olEditorHTML Then
Set htmldoc = Me.ActiveWindow.CurrentItem.GetInspector.HTMLEditor
Set xmlhttp_ = New xmlhttp
For Each currentImage In htmldoc.images
xmlhttp_.Open "GET", currentImage.src
If Left(currentImage.src, 8) <> "BLOCKED:" Then
xmlhttp_.Send
startTime = Now
pathFull = pathFolder & currentImage.nameProp
pathFull = Replace(pathFull, "?", vbNullString)
pathFull = Replace(pathFull, "&", vbNullString)
Do While xmlhttp_.readyState <> 4
If DateTime.DateDiff("s", startTime, Now) > maxTime Then Exit Do
DoEvents
Loop
If xmlhttp_.readyState = 4 Then
If Dir(pathFull) <> "" Then Kill pathFull
nrFile = freeFile
Open pathFull For Binary As #nrFile
currentResponse = xmlhttp_.responseBody
Put #nrFile, , currentResponse
Close #nrFile
End If
End If
Next currentImage
End If
Set xmlhttp_ = Nothing
Set currentImage = Nothing
Set htmldoc = Nothing
End Sub
This code will download all the images that are displayed in your ActiveWindow and save them in a folder.
You will need to add a Reference to Microsoft XML (any version >= 2.6 should work) through Tools->References in the VBA Editor
If you want to, you can also set a Reference to the Microsoft HTML Object Library and change:
Dim htmldoc As Object
Dim currentImage As Object
to:
Dim htmldoc As HTMLDocument
Dim currentImage As HTMLImg
Regarding your comment:
#marg, Thanks for the detailed response. I still cant believe the solution has to be so convoluted - the image is already displaying, why should I have to download it again? And what if I want to save only a single image? (In Outlook 2003, you were able to right click on the image and select save as... now no more.) Since this is the closes to an actual workable solution, and since there doesnt seem to be any better solution in current Outlook - i'm giving you the bounty...
I don't have 2007 to look for a non-programming solution.
I do not believe that the MailItem Object (CurrentItemin my solution is a MailItem) differs much between the versions (but I base that assumption on 0 % research :D) and I was not able to locate the direct local path where the displayed images are stored even though I am pretty sure they should be in your browsers cache-folder. Crawling your folder for a file with the name currentImage.nameProp and copying it to your destination folder would be an alternative solution. Simply redownloading the image should not be that bad :D

Resources