badtr
08-10-2015, 10:02 AM
Sorry for bad english google tranlsate :)
1- I use code
WebBrowser1.Navigate "C:\test2.jpg"
pictures taken when problems also need to send mail presentation
I tried codes
webbrowser1.navigate activePresentation.Slides(1).Shapes("test2") :banghead:
webbrowser1.navigate activePresentation.Slides(1).Shapes("test2.jpg") :banghead:
???
2- different ways
a code I found on the net
but not excel in graphics,
I want to buy a specific area on the page
Option Explicit
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Dim ImageFile As String
Private Sub CommandButton1_Click()
ExtractToTemp
WebBrowser1.Navigate ImageFile
End Sub
Sub ExtractToTemp()
Dim oSl As PowerPoint.Slide
Dim oSh As PowerPoint.Shape
Dim oXLApp As Object, oXLWB As Object, oXLSht As Object
Dim mychart As Object
Set oSl = ActivePresentation.Slides(1)
Set oSh = oSl.Shapes(1)
With oSh.OLEFormat.Object.Sheets(1)
.Shapes(1).Copy
End With
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
oXLApp.Visible = False
'~~> Open the relevant file
Set oXLWB = oXLApp.Workbooks.Add
Set oXLSht = oXLWB.Worksheets(1)
oXLSht.Paste
'~~> Save Picture Object
ImageFile = TempPath & "Tester.jpg"
If Len(Dir(ImageFile)) > 0 Then Kill ImageFile
Set mychart = oXLSht.ChartObjects(1).Chart
mychart.Export FileName:=ImageFile, FilterName:="jpg"
'~~> Wait till the file is saved
Do
If FileExists(ImageFile) = True Then Exit Do
DoEvents
Loop
oXLWB.Close SaveChanges:=False
oXLApp.Quit
Set oXLWB = Nothing
Set oXLApp = Nothing
End Sub
'~~> Get User's TempPath
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
'~~> Function tot check if file exists
Public Function FileExists(strFullPath As String) As Boolean
On Error GoTo Whoa
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileExists = True
Whoa:
On Error GoTo 0
End Function
1- I use code
WebBrowser1.Navigate "C:\test2.jpg"
pictures taken when problems also need to send mail presentation
I tried codes
webbrowser1.navigate activePresentation.Slides(1).Shapes("test2") :banghead:
webbrowser1.navigate activePresentation.Slides(1).Shapes("test2.jpg") :banghead:
???
2- different ways
a code I found on the net
but not excel in graphics,
I want to buy a specific area on the page
Option Explicit
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Dim ImageFile As String
Private Sub CommandButton1_Click()
ExtractToTemp
WebBrowser1.Navigate ImageFile
End Sub
Sub ExtractToTemp()
Dim oSl As PowerPoint.Slide
Dim oSh As PowerPoint.Shape
Dim oXLApp As Object, oXLWB As Object, oXLSht As Object
Dim mychart As Object
Set oSl = ActivePresentation.Slides(1)
Set oSh = oSl.Shapes(1)
With oSh.OLEFormat.Object.Sheets(1)
.Shapes(1).Copy
End With
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
oXLApp.Visible = False
'~~> Open the relevant file
Set oXLWB = oXLApp.Workbooks.Add
Set oXLSht = oXLWB.Worksheets(1)
oXLSht.Paste
'~~> Save Picture Object
ImageFile = TempPath & "Tester.jpg"
If Len(Dir(ImageFile)) > 0 Then Kill ImageFile
Set mychart = oXLSht.ChartObjects(1).Chart
mychart.Export FileName:=ImageFile, FilterName:="jpg"
'~~> Wait till the file is saved
Do
If FileExists(ImageFile) = True Then Exit Do
DoEvents
Loop
oXLWB.Close SaveChanges:=False
oXLApp.Quit
Set oXLWB = Nothing
Set oXLApp = Nothing
End Sub
'~~> Get User's TempPath
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
'~~> Function tot check if file exists
Public Function FileExists(strFullPath As String) As Boolean
On Error GoTo Whoa
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileExists = True
Whoa:
On Error GoTo 0
End Function