Filterergebnis als verküpfte Grafik einblenden

Hallo ihr lieben VBAaler,
ich habe mal eine Frage zu folgendem:
In
With ActiveSheet ' hier soll die Grafik eingeblendet werden!
Dim acell As Range
Set acell = Range("A3") steht eine Zahl.
Diese möchte ich als Filterkriterium anwenden in
Windows("Daten_alt.xlsx").Activate
Range("I1").Select
ActiveSheet.Range("$A$1:$J$20000").AutoFilter Field:=9, Criteria1:="acell"
Aber wie es jetzt weitergeht mit SpecialCells(xlCellTypeVisible und ActiveSheet.Pictures.Paste(Link:=True).Select
ActiveSheet.Shapes.Range(Array("Picture 4")).Select usw.
Das ist mir zu hoch, der Recorder ist da auch nur wenig hifreich.
Die Anzahl Daten aus dem Filter variiert.
Der o.g. Code ist natürlich nur zur Veranschaulichung was gemeint ist.
Kann mir mal eine/r von euch helfen das umzusetzen.
Besten Dank schon einmal im Voraus.
Gruß
Thorben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub FilterAlsBild() Dim ListenEnde As Long Dim Kriterium As String ListenEnde = Tabelle1.Cells(6, 1).End(xlDown).Row Kriterium = Tabelle1.Cells(3, 1).Value Tabelle1.Range(Cells(6, 1), Cells(ListenEnde, 9)).AutoFilter Field:=9, Criteria1:=Kriterium Tabelle1.Cells(6, 1).CurrentRegion.Copy ActiveSheet.Pictures.Paste Tabelle1.Range(Cells(6, 1), Cells(ListenEnde, 9)).AutoFilter Application.CutCopyMode = False End Sub

Sub ListenFilterAlsBild() Dim ZielMappe As Workbook Dim QuellMappe As Workbook Dim ListenEnde As Long Dim Kriterium As String Application.ScreenUpdating = False Set ZielMappe = ActiveWorkbook Set QuellMappe = Workbooks("Daten_alt.xlsx") ListenEnde = QuellMappe.Worksheets("POEC").Cells(1, 1).End(xlDown).Row Kriterium = ZielMappe.Worksheets("Tabelle1").Cells(3, 1).Value QuellMappe.Activate Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter Field:=9, Criteria1:= _ Kriterium Worksheets("POEC").Cells(1, 1).CurrentRegion.Copy ZielMappe.Activate Worksheets("Tabelle1").Pictures.Paste Application.CutCopyMode = False QuellMappe.Activate Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter ZielMappe.Activate Application.ScreenUpdating = True End Sub

Sub ListenFilterAlsBild() Dim ListenEnde As String Dim Kriterium As String Dim DieseMappe As Workbook Dim AlteMappe As Workbook Set AlteMappe = Workbooks("Daten_alt.xlsx") Set DieseMappe = ThisWorkbook ListenEnde = AlteMappe.Worksheets("POEC").Cells(1, 1).End(xlDown).Row Kriterium = DieseMappe.Worksheets("Tabelle1").Cells(3, 1).Value Application.ScreenUpdating = False With AlteMappe .Activate .Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter Field:=9, _ Criteria1:=Kriterium .Worksheets("POEC").Cells(1, 1).CurrentRegion.Copy End With With DieseMappe .Activate .ActiveSheet.Pictures.Paste End With With AlteMappe .Activate .Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter End With With Application .CutCopyMode = False .ScreenUpdating = True End With DieseMappe.Activate End Sub

Hallo Thorben!
Sorry, ich hatte noch anderes zu tun ;-)... Super, dass Du es für Dich schon gelöst hast. Ich habe Dir jetzt aber auch noch meinen Code angepasst, sodass das jeweils eingefügte Bild der gefilterten Liste immer an der selben Position eingefügt wird (die Werte für .Left und .Top musst Du natürlich anpassen):

Sub ListenFilterAlsBildNeu()
Dim ZielMappe As Workbook
Dim QuellMappe As Workbook
Dim ListenEnde As Long
Dim Kriterium As String
Dim BildZähler As Long
Set ZielMappe = ActiveWorkbook
Set QuellMappe = Workbooks("Daten_alt.xlsx")
ListenEnde = QuellMappe.Worksheets("POEC").Cells(1, 1).End(xlDown).Row
Kriterium = ZielMappe.Worksheets("Tabelle1").Cells(3, 1).Value
QuellMappe.Activate
Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter Field:=9, Criteria1:= _
Kriterium
Worksheets("POEC").Range(Cells(1, 1), Cells(Cells(1, 1).End(xlDown).Row, 9)).CopyPicture  _
xlScreen, xlBitmap
ZielMappe.Activate
Worksheets("Tabelle1").Paste Destination:=Tabelle1.Range("L1")
Application.CutCopyMode = False
QuellMappe.Activate
Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter
ZielMappe.Activate
BildZähler = ActiveSheet.Shapes.Count
With ActiveSheet.Shapes(BildZähler)
.Left = 300
.Top = 0
End With
End Sub

Schönen Abend
Michael

Sub ListenFilterAlsBildNeu() Dim ZielMappe As Workbook Dim QuellMappe As Workbook Dim ListenEnde As Long Dim Kriterium As String Dim Acell As Range Application.ScreenUpdating = False Set ZielMappe = ActiveWorkbook Set QuellMappe = Workbooks("Daten.xlsx") Set Acell = ActiveSheet.Cells(ActiveCell.Row, 1) ListenEnde = QuellMappe.Worksheets("POEC").Cells(1, 1).End(xlDown).Row Kriterium = Acell.Value QuellMappe.Activate Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter Field:=9, Criteria1:= _ Kriterium Worksheets("POEC").Range(Cells(1, 1), Cells(Cells(1, 1).End(xlDown).Row, 9)).CopyPicture _ _ Appearance:=xlScreen, Format:=xlPicture ZielMappe.Activate Worksheets("Tabelle5").Paste Destination:=Tabelle5.Cells(ActiveCell.Row, 3) Application.CutCopyMode = False QuellMappe.Activate Worksheets("POEC").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter ZielMappe.Activate Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Filterergebnis als verküpfte Grafik einblenden

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Filterergebnis als verküpfte Grafik einblenden

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread