시트를 순환하며 선택영역을 지정폴더에 JPG 출판(Ⅱ)

 

상기와 같은 이유로 아래의 프로시져는 대화상자에서 or 모듈 단위로 Call 할 때만 사용 가능.

Option Explicit
 

Sub Publish_Range_To_JPG()

  '★★시트를 순환하며 선택영역을 지정폴더에 JPG 출판★★
  
 'JPG FILE 저장 POLDER 지정
  Dim strPolderName As String
 '확장자를 포함한 워크북명
  Dim LATUS As String
 '확장자를 제거한 워크북명
  Dim strFileName As String
  Dim iSplit As Integer
  Dim sht As Worksheet
  Dim vAry() As Integer
  Dim ShtAry() As String
  Dim i As Integer
  Dim n As Integer
  Dim rng As Range
  Dim chtObj As ChartObject
  

 'JPG 저장할 폴더 선택
  With Application.FileDialog(msoFileDialogFolderPicker)
                                                       .Title = "JPG 저장할 폴더를 선택하세요"
                                                       .Show
                                                    If .SelectedItems.Count = 0 Then Exit Sub
                                       strPolderName = .SelectedItems(1)
  End With
  
  
 '지정 폴더를 열기
  Shell "rundll32.exe url.dll,FileProtocolHandler " & strPolderName, vbNormalFocus
   
  
  LATUS = ActiveWorkbook.Name
  
  
 '확장자를 제거한 워크북명(filename)
  strFileName = ""
  
  iSplit = InStrRev(LATUS, ".")
  
  If iSplit = 0 Then
     strFileName = LATUS
  Else
     strFileName = Left(LATUS, iSplit - 1)
  End If
  
  i = 0
  
 '선택된 시트를 배열에 저장
  For Each sht In ActiveWindow.SelectedSheets
      
      i = i + 1
      
      ReDim Preserve vAry(1 To i)
      ReDim Preserve ShtAry(1 To i)
      vAry(i) = sht.Index
      ShtAry(i) = sht.Name
  
  Next
    
    
 '선택된 시트를 순환하면서 JPG 저장
  For n = LBound(ShtAry) To UBound(ShtAry)
      
      Dim targetSht As Worksheet
      Set targetSht = Sheets(ShtAry(n))
      targetSht.Activate
      
     '현재 시트에서 선택된 영역 가져오기
      If TypeName(Selection) <> "Range" Then
         MsgBox "시트 [" & ShtAry(n) & "]에서 선택된 영역이 없습니다."
         GoTo NextSheet
      End If
        
        
     '현재 시트에서 선택된 영역 가져오기
      Set rng = Selection
      
     '현재 시트에서인쇄영역 전체 가져오기
     'Set rng = targetSht.Range(targetSht.PageSetup.PrintArea)
      
     
     '선택 영역을 그림으로 복사
      rng.CopyPicture xlScreen, xlPicture
      
     '프린터 기반 복사
     'rng.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
      
     
      Set chtObj = targetSht.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
    
      With chtObj
      
                 .Chart.ChartArea.Format.Line.visible = msoFalse ' 테두리 제거
      
                 '붙여넣기
                 .Chart.Paste
      
                 'JPG로 저장
                 .Chart.Export FileName:=strPolderName & "\" & strFileName & " " & _
                                                               Format(vAry(n), "000") & " " & ShtAry(n) & "_" & _
                                                               Format(Now, "yyyymmdd_hhnnss") & ".jpg", FilterName:="JPG"
                 .Delete
      
      End With
     
      Set targetSht = Nothing
      Set rng = Nothing
      Set chtObj = Nothing

NextSheet:

  Next n
  
  i = 0
  iSplit = 0
  n = 0
  strPolderName = ""
  strFileName = ""
  LATUS = ""
 
 '배열의 초기화
  Erase vAry
  Erase ShtAry

  Application.CutCopyMode = False
    
 'MsgBox "선택한 영역들이 각각 JPG로 저장되었습니다."
 
End Sub

시트를 순환하며 선택영역을 지정폴더에 JPG 출판(2).txt

0.00MB