Gefilterte Werte übertragen
16.04.2015 18:00:06
Jonas
bin ganz neu hier im Forum und kenne mich auch noch nicht besonders gut mit Excel bzw Vba aus.
Mein Problem ist, dass ich aus einer Excel-Tabelle Daten filtere, die ich dann per VBA in eine Power-Point Folie überspiele. Allerdings muss bei der Übertragung jede Zeile einzeln 'hart' eingegeben werden. Gibt es da eine Möglichkeit iwie nur z.B die ersten 8 Zeilen zu übertragen und nicht jedes mal einzugegebn um welche Zeile es sich konkret nach der Filterung handelt.
Hier mal als Bsp.:
1.Der Filter
Sub Makro3()
ActiveSheet.Range("$A$1:$J$868").AutoFilter Field:=2, Criteria1:=Array("1A" _
, "1B", "1C", "1D", "1F", "2A", "2B", "2C", "2D", "2E", "2F", "3", "4"), Operator:= _
xlFilterValues
ActiveSheet.Range("$A$1:$J$868").AutoFilter Field:=6, Criteria1:=Array( _
"Active", "Proposed", "Resolved"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$J$868").AutoFilter Field:=2, Criteria1:=Array("1A" _
, "2A", "2B", "2C", "2D", "2E", "2F", "3"), Operator:=xlFilterValues
ActiveWindow.SmallScroll Down:=-108
End Sub
2.Die Übertragung in PPT
Sub PPTausExcelBefuellen()
Dim powerpoint_datei As Object
Dim ppt_slides As Variant
Set powerpoint_datei = _
CreateObject(class:="Powerpoint.Application")
powerpoint_datei.presentations.Open Filename:="Interim Status Template bearbeitet.pptx"
ppt_slides = 1
Dim TextTFS1 As String
Dim TextTFS2 As String
Dim TextTFS3 As String
Dim TextTFS4 As String
TextTFS1 = Replace(Cells(318, 1).Text, Chr(10), Chr(13))
TextTFS2 = Replace(Cells(324, 1).Text, Chr(10), Chr(13))
TextTFS3 = Replace(Cells(479, 1).Text, Chr(10), Chr(13))
TextTFS4 = Replace(Cells(491, 1).Text, Chr(10), Chr(13))
With powerpoint_datei.ActivePresentation.Slides(ppt_slides)
.Shapes("TFS1").TextFrame.TextRange.Text = TextTFS1
.Shapes("TFS2").TextFrame.TextRange.Text = TextTFS2
.Shapes("TFS3").TextFrame.TextRange.Text = TextTFS3
.Shapes("TFS4").TextFrame.TextRange.Text = TextTFS4
End With
End Sub
Vielen Dank für eure Hilfe!