ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Charts and Charting in Excel (https://www.excelbanter.com/charts-charting-excel/)
-   -   How to automatically create a thumbnail of a published chart/image (https://www.excelbanter.com/charts-charting-excel/107045-how-automatically-create-thumbnail-published-chart-image.html)

[email protected]

How to automatically create a thumbnail of a published chart/image
 
Hi All,

Not sure whether this is the right forum for this question, but here
goes.

I have a spreadsheet with a series of statistics and graphs on it. I
have a button which links to a macro that automatically publishes these
graphs to a location on the network (see code below). My situation is
this. I need to be able to programmatically create a thumbnail of
these images for use in an HTML page which will be a link to the
full-sized image. If I just use html to re-size the image, the image
is ruined and blotchy, for lack of a better word.

Can anyone suggest a solution to my problem?

Any help would be hugely appreciated

Cheers

Rob

My current code is this:

strURL1 = "<Publish Location"
strURL2 = "<Graph Final Location"

Call pubIndividual("<graph name", "<graph alias")



Function pubIndividual
strFileNameFull = <DateStamped File Name & path

With ActiveWorkbook.PublishObjects(strChart)
.Filename = strURL1 & strFileNameFull & ".htm"
.Publish (False)
End With

CopyRenameBugFile
End Function


Sub CopyRenameBugFile()

Dim fs As Scripting.FileSystemObject
Dim f As Scripting.Folder
Dim f1 As Scripting.File

On Error GoTo CloseFilesAndRaise

Set fs = New Scripting.FileSystemObject
Set f = fs.GetFolder(strURL1 & strFileNameFull & "_files")

For Each f1 In f.Files
If UCase(Right(f1.Name, 3)) = "GIF" Then
'================================================= ========
'This is the original file that I want to resize
'================================================= ========
f1.Copy strURL2 & <Clean File Name & ".gif", True
'================================================= ========
Exit For
End If
Next

Set f = Nothing
Set fs = Nothing

Exit Sub

CloseFilesAndRaise:
Set f = Nothing
Set fs = Nothing
Err.Raise (Err)

End Sub



All times are GMT +1. The time now is 12:02 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com