엑셀 VBA 선택영역을 이미지로 추출 :: 이미지 저장 매크로 >> 이미지 파일명 변경 질문입니다

VBA
작성자
포튼가먼트
작성일
2021-11-15 14:04
조회
46
엑셀버전 : 엑셀2013

운영체제 : 윈도우10


이 강의를 보고...

열심히 따라해보고, 질문들과 그에 답변들도 열심히 살펴보았는데요 ㅠㅠㅠ

 

도대체 이미지파일명을 어떻게 원하는 셀에 있는 값으로 변경할 수 있는지 궁금합니다....

C4셀의 고객명의 이름으로 파일이 저장될수 있게는 방법좀 알려주세요 제발 부탁드려요 ㅠㅠ

현재는 엑셀이미지1, 엑셀이미지2 이런식으로 저장되고 있습니다.

 

 

Option Explicit

Sub Test()

Rng_To_Image range("A1:T28:)

End Sub

Function ValidFileName(ByVal FileName As String) As Boolean

Dim Arr As Variant: Dim Val As Variant
Dim Pnt As Long

Arr = Array("/", "\", ":", "*", "?", """", "<", ">", "|")

If InStr(1, FileName, ":\") > 0 Then
Pnt = InStrRev(FileName, "\")
FileName = Right(FileName, Len(FileName) - Pnt)
Debug.Print FileName
End If

ValidFileName = True

For Each Val In Arr
If InStr(1, FileName, Val) > 0 Then ValidFileName = False: Exit Function
Next

End Function

Sub Rng_To_Image(rngSelection As range, _
Optional FileName As String = "엑셀이미지", _
Optional SavePath As String = "", _
Optional AddSequence As Boolean = True)

Dim NewWs As Worksheet
Dim picRange As Object: Dim MyObj As Chart
Dim PicH As Double: Dim PicW As Double
Dim FilePath As String

If ValidFileName(FileName) = False Then MsgBox "올바른 파일명을 사용하세요.": End

If SavePath = "" Then SavePath = GetDesktopPath
FilePath = SavePath & FileName & ".png"

rngSelection.CopyPicture xlScreen, xlPicture

Set NewWs = ActiveWorkbook.Sheets.Add
NewWs.Paste

Set picRange = NewWs.Shapes.Item(1)
With picRange
PicH = .Height
PicW = .Width
.Delete
End With

With NewWs.Shapes.AddChart2
.Height = PicH
.Width = PicW
End With

Set MyObj = NewWs.Shapes.Item(1).Chart

MyObj.ChartArea.Select
MyObj.Paste

If AddSequence = True Then
FilePath = FileSequence(FilePath, 1)
End If

MyObj.Export FilePath, "PNG"

Application.DisplayAlerts = False
NewWs.Delete
Application.DisplayAlerts = True

End Sub

Public Function FileExists(ByVal path_ As String) As Boolean

FileExists = (Dir(path_, vbDirectory) <> "")

End Function

Public Function GetDesktopPath(Optional BackSlash As Boolean = True) As String

Dim oWSHShell As Object

Set oWSHShell = CreateObject("WScript.Shell")

If BackSlash = True Then
GetDesktopPath = oWSHShell.SpecialFolders("Desktop") & "\"
Else
GetDesktopPath = oWSHShell.SpecialFolders("Desktop")
End If

Set oWSHShell = Nothing

End Function

Function FileSequence(FilePath As String, Optional Sequence As Long = 1) As String

Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long

Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)

newPath = Path & Sequence & Ext

Do Until FileExists(newPath) = False
Sequence = Sequence + 1
newPath = Path & Sequence & Ext
Loop

FileSequence = newPath

End Function

 

회원등급 : 2레벨
포인트 : 38 EP
총질문 : 1 개 (마감율 : 0%)
채택답변 : 0 개
전체 0

전체 4,679
번호 카테고리 제목 작성자 작성일 추천 조회
공지사항 공지사항
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (10)
오빠두엑셀 | 2021.10.28 | 추천 16 | 조회 750
트로피 오빠두엑셀 2021.10.28 16 750
24253 함수/공식
New 파일과 관련된 숫자를 다른 파일에 있는 숫자로 변경할 수 있는 방법 첨부파일
안녕 | 21:59 | 추천 0 | 조회 7
안녕 21:59 0 7
24252 함수/공식
New 표 범위 내에서 맨 좌측값 가져오기 질문드립니다. (2)
김성환 | 21:40 | 추천 0 | 조회 9
김성환 21:40 0 9
24251 기능/도구
New 엑셀 주식 가격 예측 양식 사용 질문입니다. 첨부파일
thause | 21:39 | 추천 0 | 조회 10
thause 21:39 0 10
24249 VBA
New 모든 하위 폴더 내의 최신 파일 하나만을 특정 폴더로 복사하려 합니다
너의나라 | 16:49 | 추천 0 | 조회 17
너의나라 16:49 0 17
24248 차트/그래프
New 그래프에서 가로 축 Data 설정하는 법 첨부파일
Etter | 16:46 | 추천 0 | 조회 19
Etter 16:46 0 19
24245 VBA
New 아웃룩 이메일 내용에 VBA 변수 넣기
argus | 16:08 | 추천 0 | 조회 18
argus 16:08 0 18
24239 VBA
New [초보] 웹 크롤링 관련 질문입니다. 첨부파일 (2) 답변완료
스캐쳐 | 14:00 | 추천 0 | 조회 23
스캐쳐 14:00 0 23
24238 VBA
New 어떤 한 배열에서 다른 배열에 있는 값만 제외하고 새로운 배열3을 만들 수 있을까요? (2)
Paul | 13:50 | 추천 0 | 조회 24
Paul 13:50 0 24
24233 함수/공식
New 0이상의 값(유효값)이 있는 칼럼과 그 값을 불러오고 싶습니다. 첨부파일 (2) 답변완료
크놉스 | 11:41 | 추천 0 | 조회 25
크놉스 11:41 0 25
24232 차트/그래프
New 엑셀 차트에서 특정 값이 너무 높을때 차트화 하는 법 (2) 답변완료
담담 | 11:36 | 추천 0 | 조회 29
담담 11:36 0 29
24230 VBA
New vba 코딩을 부탁드립니다. 첨부파일 (2)
Trimman | 11:09 | 추천 -2 | 조회 31
Trimman 11:09 -2 31
24228 함수/공식
New 등급 기준표를 참조해서 연산을 하려고 할때 (1) 답변완료
지천 | 10:12 | 추천 0 | 조회 22
지천 10:12 0 22
24221 파워쿼리/피벗
New 엑셀 종속 테이블 문의 첨부파일 (2)
유령회원 | 08:30 | 추천 0 | 조회 22
유령회원 08:30 0 22
24216 VBA
New 로그인엑셀 사용시 수식입력줄 사라짐, 모든 엑셀창 자동종료 첨부파일 (1)
엑셀이 | 00:19 | 추천 0 | 조회 18
엑셀이 00:19 0 18
24215 VBA
New set_routine 반복 매크로 (1)
하늘의 꿈 | 2021.12.01 | 추천 0 | 조회 24
하늘의 꿈 2021.12.01 0 24
VBA
New 재질문 입니다.
하늘의 꿈 | 15:50 | 추천 0 | 조회 12
하늘의 꿈 15:50 0 12
24213 파워쿼리/피벗
New [파워쿼리] 계약자코드 중 특수계약 날짜가 일반계약 최소 최대 사이에 포함여부 열추가 첨부파일 (1)
seorin | 2021.12.01 | 추천 0 | 조회 20
seorin 2021.12.01 0 20
24211 VBA
New 시트를 메일머지하여 Hancom PDF 파일로 출력하는 매크로 VBA 코드 도움을 받고 싶어요. 첨부파일 (4) 답변완료
김학동 | 2021.12.01 | 추천 0 | 조회 32
김학동 2021.12.01 0 32
24210 함수/공식
New 혹시 이런 것도 구할 수 있을까요? (3)
마른막대기 | 2021.12.01 | 추천 0 | 조회 38
마른막대기 2021.12.01 0 38
24207 함수/공식
New 중복값 중 제일 마지막 값 추출 (2)
rladud99 | 2021.12.01 | 추천 0 | 조회 38
rladud99 2021.12.01 0 38
24203 함수/공식
New 엑셀 값 가로/세로 변경하는 방법 문의드려요! 첨부파일 (2) 답변완료
이시현 | 2021.12.01 | 추천 0 | 조회 37
이시현 2021.12.01 0 37
24200 함수/공식
New 데이터를 일정간격으로 띄워서 입력하고 싶습니다. (8) 답변완료
wlfl**** | 2021.12.01 | 추천 0 | 조회 46
wlfl**** 2021.12.01 0 46
24191 함수/공식
New 일치하는 값에 특정 데이터를 넣고싶습니다. (1)
노랑토끼 | 2021.12.01 | 추천 0 | 조회 54
노랑토끼 2021.12.01 0 54
24188 VBA
New VBA에서 이름이 긴 파일이 있는데 그 파일 이름을 바꾸고 싶습니다.(상세설명 필수) (2)
naver_618c988d51534 | 2021.12.01 | 추천 0 | 조회 30
naver_618c988d51534 2021.12.01 0 30
24184 문서서식
New 엑셀 자동채우기 관련 문의 (1) 답변완료
오문환 | 2021.12.01 | 추천 0 | 조회 42
오문환 2021.12.01 0 42
24182 함수/공식
New 줄바꿈 함수 도와주세요 첨부파일 (3)
김상준 | 2021.12.01 | 추천 1 | 조회 43
김상준 2021.12.01 1 43
24177 기능/도구
New 매크로 와 자동필터
FLOWERBALL | 2021.11.30 | 추천 0 | 조회 48
FLOWERBALL 2021.11.30 0 48
24168 VBA
New (문의) 번호가 같을경우 옆에 있는 셀의 값을 병합 (1)
ryan_cruze | 2021.11.30 | 추천 0 | 조회 43
ryan_cruze 2021.11.30 0 43
24166 기능/도구
New 질문있습니다.
최강씨맨 | 2021.11.30 | 추천 0 | 조회 34
최강씨맨 2021.11.30 0 34
24163 함수/공식
New 엑셀 특정 내용 추출하는 수식 질문드립니다. (2)
PAKSAW | 2021.11.30 | 추천 0 | 조회 52
PAKSAW 2021.11.30 0 52
24161 함수/공식
New 특정 날짜 값 찾기 (2)
ㄱ박민극 | 2021.11.30 | 추천 -1 | 조회 47
ㄱ박민극 2021.11.30 -1 47