वीबीए

Question

का उपयोग कर एक्सेल फ़ाइल से jpg में चित्रों को निर्यात करें मेरे पास एक एक्सेल फ़ाइल है जिसमें कॉलम बी में चित्र शामिल हैं और मैं उन्हें .jpg (या कोई अन्य चित्र फ़ाइल प्रारूप) के रूप में कई फ़ाइलों में निर्यात करना चाहता हूं। ,

Private Sub CommandButton1_Click() 
Dim oTxt As Object 
For Each cell In Ark1.Range("A1:A" & Ark1.UsedRange.Rows.Count) 
' you can change the sheet1 to your own choice 
saveText = cell.Text 
Open "H:\Webshop_Zpider\Strukturbildene\" & saveText & ".jpg" For Output As #1 
Print #1, cell.Offset(0, 1).text 
Close #1 
Next cell 
End Sub 

नतीजा यह है कि यह उत्पन्न फ़ाइलें (jpg) है किसी भी सामग्री को बिना: फ़ाइल का नाम स्तंभ A में पाठ मैं VBA मैक्रो निम्नलिखित की कोशिश की से उत्पन्न किया जाना चाहिए। मुझे लगता है कि लाइन Print #1, cell.Offset(0, 1).text. गलत है। मुझे नहीं पता कि मुझे इसे बदलने की क्या ज़रूरत है, cell.Offset(0, 1).pix?

क्या कोई मेरी मदद कर सकता है? धन्यवाद!

Answer 1

इस कोड:

Option Explicit 

Sub ExportMyPicture() 

    Dim MyChart As String, MyPicture As String 
    Dim PicWidth As Long, PicHeight As Long 

    Application.ScreenUpdating = False 
    On Error GoTo Finish 

    MyPicture = Selection.Name 
    With Selection 
      PicHeight = .ShapeRange.Height 
      PicWidth = .ShapeRange.Width 
    End With 

    Charts.Add 
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1" 
    Selection.Border.LineStyle = 0 
    MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2) 

    With ActiveSheet 
      With .Shapes(MyChart) 
       .Width = PicWidth 
       .Height = PicHeight 
      End With 

      .Shapes(MyPicture).Copy 

      With ActiveChart 
       .ChartArea.Select 
       .Paste 
      End With 

      .ChartObjects(1).Chart.Export Filename:="MyPic.jpg", FilterName:="jpg" 
      .Shapes(MyChart).Cut 
    End With 

    Application.ScreenUpdating = True 
    Exit Sub 

Finish: 
    MsgBox "You must select a picture" 
End Sub 

सीधे here से नकल, और मामलों मैं परीक्षण किया के लिए खूबसूरती से काम करता है किया गया था।

Answer 2

यदि मुझे सही याद है, तो आपको अपनी शीट की "आकार" संपत्ति का उपयोग करने की आवश्यकता है।

प्रत्येक आकार ऑब्जेक्ट में टॉप लाइफसेल और BottomRightCell विशेषताएँ हैं जो आपको छवि की स्थिति बताती हैं।

यहां कुछ समय पहले इस्तेमाल किया गया कोड का एक टुकड़ा है, जो आपकी आवश्यकताओं के अनुरूप है। मैं उन सभी ChartObjects और whatnot के बारे में विशेष याद नहीं है, लेकिन यहाँ यह है:

For Each oShape In ActiveSheet.Shapes 
    strImageName = ActiveSheet.Cells(oShape.TopLeftCell.Row, 1).Value 
    oShape.Select 
    'Picture format initialization 
    Selection.ShapeRange.PictureFormat.Contrast = 0.5: Selection.ShapeRange.PictureFormat.Brightness = 0.5: Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic: Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse: Selection.ShapeRange.Fill.Visible = msoFalse: Selection.ShapeRange.Line.Visible = msoFalse: Selection.ShapeRange.Rotation = 0#: Selection.ShapeRange.PictureFormat.CropLeft = 0#: Selection.ShapeRange.PictureFormat.CropRight = 0#: Selection.ShapeRange.PictureFormat.CropTop = 0#: Selection.ShapeRange.PictureFormat.CropBottom = 0#: Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft: Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft 
    '/Picture format initialization 
    Application.Selection.CopyPicture 
    Set oDia = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width, oShape.Height) 
    Set oChartArea = oDia.Chart 
    oDia.Activate 
    With oChartArea 
     .ChartArea.Select 
     .Paste 
     .Export ("H:\Webshop_Zpider\Strukturbildene\" & strImageName & ".jpg") 
    End With 
    oDia.Delete 'oChartArea.Delete 
Next 

Answer 3

यहाँ बाहरी दर्शक है कि कमांड लाइन स्विच (IrfanView इस मामले में) स्वीकार एन का उपयोग कर है- ऐसा करने के लिए एक और अच्छा तरीका है : * मैंने माइकल क्रज़िच ने जो लिखा है उस पर लूप आधारित है।

Sub ExportPicturesToFiles() 
    Const saveSceenshotTo As String = "C:\temp\" 
    Const pictureFormat As String = ".jpg" 

    Dim pic As Shape 
    Dim sFileName As String 
    Dim i As Long 

    i = 1 

    For Each pic In ActiveSheet.Shapes 
     pic.Copy 
     sFileName = saveSceenshotTo & Range("A" & i).Text & pictureFormat 

     Call ExportPicWithIfran(sFileName) 

     i = i + 1 
    Next 
End Sub 

Public Sub ExportPicWithIfran(sSaveAsPath As String) 
    Const sIfranPath As String = "C:\Program Files\IrfanView\i_view32.exe" 
    Dim sRunIfran As String 

    sRunIfran = sIfranPath & " /clippaste /convert=" & _ 
          sSaveAsPath & " /killmesoftly" 

    ' Shell is no good here. If you have more than 1 pic, it will 
    ' mess things up (pics will over run other pics, becuase Shell does 
    ' not make vba wait for the script to finish). 
    ' Shell sRunIfran, vbHide 

    ' Correct way (it will now wait for the batch to finish): 
    call MyShell(sRunIfran) 
End Sub 

संपादित करें:

Private Sub MyShell(strShell As String) 
    ' based on: 
    ' http://stackoverflow.com/questions/15951837/excel-vba-wait-for-shell-command-to-complete 
    ' by Nate Hekman 

    Dim wsh As Object 
    Dim waitOnReturn As Boolean: 
    Dim windowStyle As VbAppWinStyle 

    Set wsh = VBA.CreateObject("WScript.Shell") 
    waitOnReturn = True 
    windowStyle = vbHide 

    wsh.Run strShell, windowStyle, waitOnReturn 
End Sub 

Answer 4

Dim filepath as string 
Sheets("Sheet 1").ChartObjects("Chart 1").Chart.Export filepath & "Name.jpg" 

निरपेक्ष न्यूनतम करने के लिए कोड नीचे Slimmed यदि आवश्यक हो तो।

Answer 5

'' 'सीमा निर्धारित करें आप

कार्यपुस्तिकाएं ("अपनी कार्यपुस्तिका नाम")। शीट ("yoursheet नाम")। का चयन करें

Dim rgExp As Range: Set rgExp = Range("A1:H31") 
''' Copy range as picture onto Clipboard 
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
''' Create an empty chart with exact size of range copied 
With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _ 
Width:=rgExp.Width, Height:=rgExp.Height) 
.Name = "ChartVolumeMetricsDevEXPORT" 
.Activate 
End With 
''' Paste into chart area, export to file, delete chart. 
ActiveChart.Paste 
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "C:\ExportmyChart.jpg" 
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete