snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Sub SaveImages()
'the location to save all the images
Const destFolder$ = "C:\Users\user\Desktop\New folder\"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("image")
Dim ppt As Object, ps As Variant, slide As Variant
Set ppt = CreateObject("PowerPoint.application")
Set ps = ppt.presentations.Add
Set slide = ps.slides.Add(1, 1)
Dim shp As Shape, shpName$
For Each shp In ws.Shapes
shpName = destFolder & shp.TopLeftCell.Offset(1, 1) & ".jpg"
shp.Copy
With slide
.Shapes.Paste
.Shapes(.Shapes.Count).Export shpName, 2
.Shapes(.Shapes.Count).Delete
End With
Next shp
With ps
.Saved = True
.Close
End With
ppt.Quit
Set ppt = Nothing
End Sub
You do not have the required permissions to view the files attached to this post.
Sub Export_Pictures()
Dim picturename As String, mypath As String
Dim PicWidth As Double, PicHeight As Long
Dim init_PicWidth As Long, init_PicHeight As Double
Dim shp As Shape
Dim tempChart As Chart
Dim chartName As String
Dim sheetname As String
Dim sh As Worksheet
mypath = "C:\Users\safe\Desktop\New folder\"
sheetname = ActiveSheet.Name
Set tempChart = Charts.Add
tempChart.Location xlLocationAsObject, Name:=sheetname
chartName = Mid(ActiveChart.Name, Len(sheetname) + 2)
For Each shp In ActiveSheet.Shapes
picturename = Replace(shp.TopLeftCell.Offset(0, 1).Value, "/", "-")
picturename = Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(picturename, _
Chr(10), " "), " ", " ")
init_PicWidth = shp.Width
init_PicHeight = shp.Height
If shp.Name <> "Chart 1" And shp.HasChart = False Then
If Dir(flowerpath & picturename & ".jpg") = "" Then
shp.ScaleHeight 1#, True, msoScaleFromTopLeft
PicHeight = shp.Height
PicWidth = shp.Width
With ActiveSheet.Shapes(chartName)
.Width = shp.Width
.Height = shp.Height
End With
shp.Copy
ActiveChart.Paste
ActiveChart.Export Filename:=mypath & picturename & ".jpg", FilterName:="jpg"
shp.Width = init_PicWidth
shp.Height = init_PicHeight
ActiveChart.Shapes(1).Delete
End If
End If
Next
ActiveChart.ChartArea.Clear
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
