나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내

작성자:  

 김현수 (khs69)

추천:  2
파일:     조회:  1523
제목:   일정범위를 그림파일로 저장 코딩이라는데요?
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):

* 아래줄에 질문을 작성하세요 >>2016

워크시트의 일정범위를 그림 파일로 내보내는 간단한 예제입니다.
  
Option Explicit
 Dim gsglWidhth As Single
Dim gsglHeight As Single
 Function dhRngToImage(rngDb As Range) As String
Dim s As Worksheet
Dim p As Shape
Dim i As Long
Dim c As ChartObject
Dim strImgFile As String
     strImgFile = Application.DefaultFilePath & Application.PathSeparator & "IMG" & Format(Now(), "YYYYMMDDHHMMSS") & Format(Rnd() * 10000, "000000") & ".jpg"
On Error Resume Next
 Application.ScreenUpdating = False
     Set s = rngDb.Parent
    Set p = s.Shapes.AddShape(1, 1, 1, 1, 1)
    i = s.Shapes.Count
    rngDb.Copy
    p.Select
    s.Paste
    p.Delete
    If i = s.Shapes.Count Then
        Set p = s.Shapes(i)
        With p
            gsglHeight = .Height
            gsglWidhth = .Width
            Set c = s.ChartObjects.Add(1, 1, gsglWidhth, gsglHeight)
            p.CopyPicture 1, 2
            With c.Chart
                .Paste
                .Export Filename:=strImgFile, FilterName:="JPG"
            End With
            c.Delete '차트 삭제
            .Delete '이미지 삭제
        End With
    Else
    End If
Application.ScreenUpdating = True
    If Dir(strImgFile) = "" Then
    Else
        dhRngToImage = strImgFile
    End If
On Error Resume Next
    Set s = Nothing
    Set p = Nothing
    Set c = Nothing
End Function

아랫부분이 해결이 안되어서, 며칠째 검색을 하고 있습니다.
한 코딩이 유사하지 않을까 가져 왔습니다 만..
이 코딩은 어떻게 실행이 되는건가요?

전, 보통 Sub test() ~ End Sub 로 된것을 버튼을 만들어서
연결해서 실행을 응용하는지라??

위 코딩은 도대체 어떻게 실행을 해 볼수 있는지요?
 
[불량 게시물 신고]  
dew사용자 정의함수 입니다...
아래와 같이 다른 프로그램에서 호출하여 사용하세요.

Sub test()
    Dim vAns
    
    vAns = dhRngToImage(ActiveSheet.Range("A1:K16"))
    
    If vAns <> "" Then
        MsgBox "그림파일 위치 : " & vAns, vbInformation
    End If
End Sub
08-06 (09:15)
삭제 ■신고
        
  

작성일 : 2019-08-01(17:33)
최종수정일 : 2019-08-01(17:33)