Opgelost Bereik naar JPG plaatsing module?

[Senso]

Ik heb onderstaande code gevonden. Lijkt mij handig maar moet geschikt zijn voor meerdere documenten. Waar plaats ik de module? Ik heb twee pc's.

Sub CopyRangeToJpeg()
    Dim aChart As Chart, Rng As Range, Path As String
    Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "Capture.jpg"
    'Set Rng = Sheets("TABLE").Range("C2:G57")
    Set Rng = Range("X1:AI37")
    Call Rng.CopyPicture(xlScreen, xlPicture)
    With Sheets.Add
        .Shapes.AddChart
        .Activate
        .Shapes.Item(1).Select
        Set aChart = ActiveChart
        .Shapes.Item(1).Line.Visible = msoFalse
        .Shapes.Item(1).Width = Rng.Width
        .Shapes.Item(1).Height = Rng.Height
        aChart.Paste
        aChart.Export (Path)
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved to " & vbCr & Path, vbInformation, ""
End Sub

 

[snb]

Alternatieve code:
opslaan in personal.xlsb

Sub M_afbeelding_van_werkblad_opslaan_snb()
  With ActiveSheet.UsedRange
    .CopyPicture
    With .Parent.ChartObjects.Add(5, 5, .Width, .Height).Chart
      .Paste
      .Export ThisWorkbook.Path & "\werkblad.gif", "GIF"
      .Parent.Delete
    End With
  End With
End Sub

 

[Senso]

Opslaan als Module? (3) zie afbeelding?
Waar zit het bereik in jouw code? Of moet je dat zelf vaststellen door te selecteren?

Nu maak ik een filter gebaseerd op celwaarde in kolom A. Dan vallen rijen weg. Hoe geef ik dan het bereik in de VBA aan van wat ik op de filter/afbeelding wil zien.

 

[snb]

Wat is het Engelse woord voor bereik ?
Een macro sla je op als procedure in een codemodule (van een werkboek, een werkblad, een Userform een Class module of een macromodule.
Wil je hem overal gebruiken sla hem dan als procedure op in een macromodule van het personal.xlsb bestand dat bij opening van Excel verborgen geladen wordt.

 

[Senso]

Set Range for VBA Chart

It appears that my code is building the charts off of the set range. Is it possible to pre-select my range before I execute the macro and have the code build the chart off of the pre-selected range? activeChart.SetSourceData Source:=Range("'Chart Data'!$A$32:$L$36")

www.mrexcel.com

Hier is het mogelijk het bereik te selecteren alvorens de macro uit te voeren. Is die niet in de code van post 1 op te nemen? Rest wat die in een filter doet?

 

[snb]

Lees nog eens goed. Gebruik ook de zoekfunktie in de VBeditor of je VBA-handboek.

 

[Senso]

Ik krijg het niet voor elkaar.
Onderstaande code moet een samenvoeging worden. Eerst gebied selecteren en vervolgens van dat gebied afbeelding/capture maken.
Van SNB is mij veel te moeilijk.

Sub RangeSelectionPrompt()
    Dim rng As Range
    Set rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)

    MsgBox "The cells selected were " & rng.Address
End Sub

Sub CopyRangeToJpeg()
    Dim aChart As Chart, rng As Range, Path As String
    Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "Capture.jpg"
    'Set Rng = Range("C2:G57")
    'Set rng = Range("A1:J22")
    'Ans = Application.InputBox("Enter Chart Range", Type:=8)
    'ActiveChart.SetSourceData Source:=Range(Ans)
        
    Call rng.CopyPicture(xlScreen, xlPicture)
    With Sheets.Add
        .Shapes.AddChart
        .Activate
        .Shapes.Item(1).Select
        Set aChart = ActiveChart
        .Shapes.Item(1).Line.Visible = msoFalse
        .Shapes.Item(1).Width = rng.Width
        .Shapes.Item(1).Height = rng.Height
        aChart.Paste
        aChart.Export (Path)
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved to " & vbCr & Path, vbInformation, ""
End Sub

 

[AHulpje]

Je was er bijna...

 

[Senso]

Ga ik nakijken. Alvast bedankt.
Heel mooi. Getest en werkt volgens mij goed, ook in filters.

 

[Senso]

Ga ik nakijken. Alvast bedankt.
Heel mooi. Getest en werkt volgens mij goed, ook in filters.

Nu krijg je aan het einde Saved to C:\pad druk OK
Dat kun je bij invoering van Save as weglaten
Mooier zou zijn dat die vraagt > Save as en een naam kunt invoeren
Ik moet honderden afbeeldingen maken. Telkens de naam Capture schiet niet op. Bestanden moeten altijd naar het bureaublad.
@AHulpje zou jij dat nog in de code willen verwerken?

 

[AHulpje]

Honderden afbeeldingen? Dat vraagt om automatisering.
Uit meerdere documenten en meerdere werkbladen?
Allemaal dezelfde of verschillende ranges?
Misschien een voorbeelddocument plaatsen?

 

[Senso]

'Honderden afbeeldingen? Dat vraagt om automatisering.'
Nee. Niet te ingewikkeld maken.

Het zijn afbeeldingen van filters in jaarstukken. Kun je ze snel inzien! Meerdere documenten en ranges.
Maar goed. Wat jij nu aangedragen hebt, is uitstekend. Alleen dat laatste is overbodig. We weten allemaal dat de afbeelding is opgeslagen. Maar de naam Capture bestaat al en is onhandig. Ik wil gelijk een korte naam of code bv. D501 kunnen meegeven bij het opslaan. Moet dan opgeslagen worden als .jpg file

Deze gevonden:

Sub Test()
Static DefFileName As String
Dim SaveAsFileName As Variant
'Static variables keeps there values between the calls
If DefFileName = "" Then
'The default file name can contain a path:
DefFileName = Environ("USERPROFILE") & "\MyFile.CSV"
End If
'Ask the user
SaveAsFileName = Application.GetSaveAsFilename( _
DefFileName, "CSV Files (*.csv), *.csv")
If VarType(SaveAsFileName) = vbBoolean Then
'Aborted
Exit Sub
End If
ActiveWorkbook.SaveAs SaveAsFileName, xlCSV, CreateBackup:=False
End Sub

 

[AHulpje]

Ok:

 

[Senso]

Ja, uitstekend werk. Had ik veel eerder moeten hebben.
Kijken of het in de praktijk allemaal goed uitpakt. Dat duurt nog even.

@AHulpje
Jij bent goud waard!