Hello,
Not sure if this group deals with macros ... hope so
I've created a macro which successfully exports to PNG or GIF an image of a
Pie Chart. I tried to use the same macro to export an Organizational Chart.
Routine does not seem to find it. Macro code is below.
The first macros are helpers ... again, they do work for a pie chart
The routine "Sub ExportCharts_PNG_Prompt()" is the macro.
Thanks
Steve G

'================================================= =====
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

'================================================= =====
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'===============================
Private Function GetDirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
'================================================= =======


Sub ExportCharts_PNG_Prompt()
Dim MyPath As String
Dim ImagePath As String
Dim Filename As String
Dim i As Long
Dim Today
Dim DateSuffix As String
Dim ClientName As String

ImagePath = Evaluate(ActiveWorkbook.Names.Item("DefaultImagePa th").Value)
DateSuffix = Format(Now, "YYYY-MM-DD")

If (ImagePath = "") Then
ImagePath = GetDirectory("Select Directory to Store Images")
ImagePath = InputBox("Enter File Path: ", "Get File Path", ImagePath)
End If

ClientName = InputBox("Enter Client ID (no spaces): ", "Get Client ID",
"ClientIDHere")


For i = 1 To ActiveSheet.ChartObjects.Count
Filename = InputBox("Enter Filename for Chart '" _
& ActiveSheet.ChartObjects(i).Name & "':", "Enter .PNG Image Name", _
ClientName & "_" & ActiveSheet.ChartObjects(i).Name & "_" & DateSuffix)
ActiveSheet.ChartObjects(i).Chart.Export _
ImagePath & "\" & Filename & ".PNG", "PNG"
Next
End Sub

There might be people here that can answer your question, but there is
a programming group that may have more experience:
http://groups.google.com/group/micro...g/topics?hl=en

Also, I can see how the macro would make this convenient, but if you
don't get anywhere with fixing that, you can always right-click on the
org chart, select copy, and then paste it into the Microsoft Office
Picture Manager to create the image (I think those objects will
default to png).

On May 22, 2:34 pm, Steve G <Steve
wrote:
Hello,
Not sure if this group deals with macros ... hope so
I've created a macro which successfully exports to PNG or GIF an image of a
Pie Chart. I tried to use the same macro to export an Organizational Chart.
Routine does not seem to find it. Macro code is below.
The first macros are helpers ... again, they do work for a pie chart
The routine "Sub ExportCharts_PNG_Prompt()" is the macro.
Thanks
Steve G

'================================================= =====
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

'================================================= =====
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'===============================
Private Function GetDirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
'================================================= =======

Sub ExportCharts_PNG_Prompt()
Dim MyPath As String
Dim ImagePath As String
Dim Filename As String
Dim i As Long
Dim Today
Dim DateSuffix As String
Dim ClientName As String

ImagePath = Evaluate(ActiveWorkbook.Names.Item("DefaultImagePa th").Value)
DateSuffix = Format(Now, "YYYY-MM-DD")

If (ImagePath = "") Then
ImagePath = GetDirectory("Select Directory to Store Images")
ImagePath = InputBox("Enter File Path: ", "Get File Path", ImagePath)
End If

ClientName = InputBox("Enter Client ID (no spaces): ", "Get Client ID",
"ClientIDHere")

For i = 1 To ActiveSheet.ChartObjects.Count
Filename = InputBox("Enter Filename for Chart '" _
& ActiveSheet.ChartObjects(i).Name & "':", "Enter .PNG Image Name", _
ClientName & "_" & ActiveSheet.ChartObjects(i).Name & "_" & DateSuffix)
ActiveSheet.ChartObjects(i).Chart.Export _
ImagePath & "\" & Filename & ".PNG", "PNG"
Next
End Sub