एक्सेल VBA स्क्रीनशॉट

Question

बचाने मैं VBA कोड के साथ Excel में एक वर्कशीट के एक स्क्रीनशॉट लेने के लिए कोशिश करते हैं और फिर एक निर्दिष्ट पथ में सहेजने के लिए, लेकिन मैं इसे ठीक से बचाने के लिए प्रबंधित नहीं करते हैं ...

Sub My_Macro(Test, Path) 
    Dim sSheetName As String 
    Dim oRangeToCopy As Range 
    Dim FirstCell As Range, LastCell As Range 

    Worksheets(Test).Activate 
    Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _ 
     SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _ 
     Cells.Find(What:="*", SearchOrder:=xlByColumns, _ 
     SearchDirection:=xlPrevious, LookIn:=xlValues).Column) 
    Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _ 
     SearchDirection:=xlNext, LookIn:=xlValues).Row, _ 
     Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _ 
     SearchDirection:=xlNext, LookIn:=xlValues).Column) 

    sSheetName = Test ' worksheet to work on 

    With Worksheets(sSheetName) 
     .Range(FirstCell, LastCell).CopyPicture xlScreen, xlPicture 
     .Export Filename:=Path + Test + ".jpg", Filtername:="JPG" 
    End With 

End Sub 

एक्सेल स्क्रीनशॉट लेने के बाद सीधे विधि निष्पादित करना चाहता है। एक्सपोर्ट ...। तो मैंने तस्वीर को एक नए चार्ट में पेस्ट करने का प्रयास किया। एक्सेल मेरी तस्वीर पर एक चार्ट के साथ सही जगह पर चार्ट चित्र को बचाने ... मैं भी एक अस्थायी कार्यपत्रक में पेस्ट करने की कोशिश की लेकिन एक्सेल निर्यात करने के लिए नहीं चाहता है ...

किसी भी विचार

Answer 1

लुब्स सूक के विचार से व्यस्त था।

बस चार्ट का आकार बदलें। नीचे लिपि देखें।

Sub My_Macro(Test, Path) 


Test = "UNIT 31" 
    Dim sSheetName As String 
    Dim oRangeToCopy As Range 
    Dim FirstCell As Range, LastCell As Range 

    Worksheets(Test).Activate 

    Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _ 
     SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _ 
     Cells.Find(What:="*", SearchOrder:=xlByColumns, _ 
     SearchDirection:=xlPrevious, LookIn:=xlValues).Column) 

    Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _ 
     SearchDirection:=xlNext, LookIn:=xlValues).Row, _ 
     Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _ 
     SearchDirection:=xlNext, LookIn:=xlValues).Column) 

    sSheetName = Test ' worksheet to work on 

    With Worksheets(sSheetName).Range(FirstCell, LastCell) 

     .CopyPicture xlScreen, xlPicture 
     'Getting the Range height 
     PicHeight = .Height 
     'Getting the Range Width 
     PicWidth = .Width 

     ''.Export Filename:=Path + Test + ".jpg", Filtername:="JPG" 'REMOVE THIS LINE 


    End With 


    With Worksheets(sSheetName) 

     'Creating the Chart 
     .ChartObjects.Add(30, 44, PicWidth, PicHeight).Name = "TempChart" 

     With .ChartObjects("TempChart") 

      'Pasting the Image 
      .Chart.Paste 
      'Exporting the Chart 
      .Chart.Export Filename:=Path + Test + ".jpg", Filtername:="JPG" 

     End With 

     .ChartObjects("TempChart").Delete 

    End With 

End Sub 

Answer 2

मैं कुछ महीने पहले कुछ कर रहा था। मुझे विशेष सीमा का स्क्रीनशॉट बनाने और फ़ाइल में निर्यात करने की आवश्यकता थी। टेबल में हेडमैशिंग के घंटों के बाद मुझे .chart.export के साथ समाधान मिला जो मेरे लिए सबसे अधिक अनुकूल है। कृपया मेरे कोड पर एक नज़र डालें, मुझे लगता है कि आप इसे आसानी से अपनी जरूरत के अनुसार अपडेट कर सकते हैं। सरल विचार चार्ट बनाना है, जो भी आप चाहते हैं उसे स्क्रीनशॉट लेने के लिए पेस्ट करें, चित्र को चार्ट निर्यात करें और फिर आईडी हटाएं। सरल और सुरुचिपूर्ण। पूछने के लिए स्वतंत्र महसूस अगर कोई समस्या

Sub takeScreen() 
    Dim mainSheet As Worksheet 
    Set mainSheet = Sheets("Input-Output") 

    Dim path As String 
    path = Application.ActiveWorkbook.path 

    Application.ScreenUpdating = False 


    If Dir(path & "\figures\", vbDirectory) = "" Then 
     MsgBox "Directory figures not found. Cannot save image." 
     Exit Sub 
    End If 

    With mainSheet 
     .ChartObjects.Add(30, 44, 765, 868).Name = "exportChart" 
     With .ChartObjects("exportChart") 
      .Chart.ChartArea.Border.LineStyle = xlNone 
      .Chart.ChartArea.Fill.Visible = False 
      mainSheet.Range(mainSheet.Cells(4, "B"), mainSheet.Cells(60, "L")).CopyPicture 
      .Chart.Paste 
      .Chart.Export fileName:=path & "\figures\" & "fatigue_summary.png ", FilterName:="png" 
     End With 
     .ChartObjects("exportChart").Delete 
    End With 

    Application.ScreenUpdating = True 

End Sub 

अपनी टिप्पणी के अनुसार

है, मुझे लगता है कि आप पंक्ति/स्तंभ आकार और उनके गिनती से चार्ट आकार की गणना कर सकते हैं। या आप कक्ष स्थिति और आकार विशेषताओं का उपयोग कर चार्ट का आकार बदल सकते हैं। (look for .cells().width, .cells().height,.cells().top, .cells().left)