소프트웨어 엑셀 파일에 사진들이 셀에 들어가 있는데, 이 사진들만 따로 저장가능한가요?
2019.12.27 12:26
엑셀 파일에 사진들이 셀에 들어가 있는데, 이 사진들만 따로 저장가능한가요?
저는 이 사진들만 필요해서 그렇습니다.
사진마다 각각 단일 파일들로.
댓글 [3]
-
sTarTrak 2019.12.27 14:40
-
brucex 2019.12.28 01:26
고맙습니다.
-
오후9시7분 2019.12.28 21:34
Sub demo()
Dim image As Object, picRange As Object
Dim myChart As Chart
Dim saveFolder As String, savePath As String
Dim newSht As Worksheet
Dim cnt As Long, picH As Long, picW As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If ThisWorkbook.Path = "" Then
saveFolder = GetDesktopPath
Else
saveFolder = ThisWorkbook.Path
End If
cnt = ActiveSheet.Shapes.Count
For Each image In ActiveSheet.Shapes
image.CopyPicture xlScreen, xlPicture
Set newSht = ActiveWorkbook.Sheets.Add
newSht.Paste
Set picRange = newSht.Shapes.Item(1)
With picRange
picH = .Height
picW = .Width
.Delete
End With
With newSht.Shapes.AddChart
.Height = picH
.Width = picW
End With
Set myChart = newSht.Shapes.Item(1).Chart
myChart.ChartArea.Select
myChart.Paste
savePath = saveFolder & Application.PathSeparator & image.Name & ".png"
myChart.Export savePath, "PNG"
newSht.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "완료. 이미지 갯수: " & cnt
End Sub
Function GetDesktopPath()
Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
GetDesktopPath = oWSHShell.specialfolders("Desktop")
End Function
구글링입니다,,,
https://seoya78.tistory.com/35