24.10.2017, 15:52
(Dieser Beitrag wurde zuletzt bearbeitet: 25.10.2017, 07:29 von WillWissen.
Bearbeitungsgrund: Code in Codetags gesetzt
)
Hallo zusammen.
Seit ein paar Tagen arbeite ich an einem Macro, dass automatisch ein Pivot generiert. Mein Ziel ist, dass die Links aus dem Report auch in der Pivot Tabelle klickbar werden.
Dies habe ich erzielt, in dem ich das durch das Macro entstandene Sheet (Pivot in new sheet) in VBA bearbeite.
Und zwar durch den folgenden Text:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update 20140814
If Target.Cells.Count <> 1 Then Exit Sub
On Error Resume Next
Application.ActiveWorkbook.FollowHyperlink Address:=CStr(Target.Value), NewWindow:=True
End Sub
-> Es funkitoniert. Aber i ch kann einfach nicht diesen Text, in das aufgenommene Macro (Record Macro) implementieren. Ist es überhaupt möglich? Wenn ja, wo soll dann denn der Text hin?
FAZIT: Ich möchte, dass mit dem Macro-Short-Cut nicht nur sich die Pivot Tabelle generiert, sondern auch das neu entstandene Sheet über die Eigenschaft aus dem blauen Text verfügt. Ich hoffe, dass ihr mich verstehen könnt.
Unten findet ihr das Macro im VBA Code:
____________________________
_________________________________
Seit ein paar Tagen arbeite ich an einem Macro, dass automatisch ein Pivot generiert. Mein Ziel ist, dass die Links aus dem Report auch in der Pivot Tabelle klickbar werden.
Dies habe ich erzielt, in dem ich das durch das Macro entstandene Sheet (Pivot in new sheet) in VBA bearbeite.
Und zwar durch den folgenden Text:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update 20140814
If Target.Cells.Count <> 1 Then Exit Sub
On Error Resume Next
Application.ActiveWorkbook.FollowHyperlink Address:=CStr(Target.Value), NewWindow:=True
End Sub
-> Es funkitoniert. Aber i ch kann einfach nicht diesen Text, in das aufgenommene Macro (Record Macro) implementieren. Ist es überhaupt möglich? Wenn ja, wo soll dann denn der Text hin?
FAZIT: Ich möchte, dass mit dem Macro-Short-Cut nicht nur sich die Pivot Tabelle generiert, sondern auch das neu entstandene Sheet über die Eigenschaft aus dem blauen Text verfügt. Ich hoffe, dass ihr mich verstehen könnt.
Unten findet ihr das Macro im VBA Code:
____________________________
Code:
Sub Fehlerbericht1()
'
' Fehlerbericht1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Range("B1").Select
ActiveCell.FormulaR1C1 = "Login"
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Range("E1").Select
ActiveCell.FormulaR1C1 = "Overturn Category"
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.FormulaR1C1 = "Blueshift ID"
Columns("F:F").Select
Range("F2").Activate
ActiveCell.FormulaR1C1 = _
"=HYPERLINK(""https://blueshift-inspector.amazon.com/html/index.html?id=""&RC[1],""https://blueshift-inspector.amazon.com/html/index.html?id=""&RC[1])"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F3438")
Range("F2:F3438").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Transcription_overturned_2017_1!R1C1:R3438C7", Version:=6).CreatePivotTable _
TableDestination:="Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion _
:=6
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Login")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Blueshift ID")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category")
.PivotItems("[""content"", ""gender"", ""speakerNativity""]").Visible = _
False
.PivotItems("[""content"", ""gender""]").Visible = False
.PivotItems("[""content"", ""speakerNativity""]").Visible = False
.PivotItems("[""content"", ""state"", ""gender"", ""speakerNativity""]"). _
Visible = False
.PivotItems("[""gender"", ""speakerNativity""]").Visible = False
.PivotItems("[""state"", ""gender"", ""speakerNativity""]").Visible = False
End With
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category"). _
PivotItems("[""content""]").ShowDetail = False
Range("A5").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category"). _
PivotItems("[""criticalData""]").ShowDetail = False
Range("A6").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category"). _
PivotItems("[""gender""]").ShowDetail = False
Range("A7").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category"). _
PivotItems("[""speakerNativity""]").ShowDetail = False
Range("A8").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Overturn Category"). _
PivotItems("[""state""]").ShowDetail = False
Range("B3").Select
ActiveCell.FormulaR1C1 = "Kommentar 1"
Range("C3").Select
ActiveCell.FormulaR1C1 = "Kommentar 2"
Range("B4").Select
ActiveCell.FormulaR1C1 = " "
Range("C4").Select
ActiveCell.FormulaR1C1 = " "
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B9")
Range("B4:B9").Select
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:C9")
Range("C4:C9").Select
Range("B3:C3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A3:C3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("A:C").Select
Selection.ColumnWidth = 50
Range("A2").Select
End Sub_________________________________
