Posts

Showing posts from October, 2022

Control Pivot Table Slicers Using VBA

Control Pivot Table Slicers Using VBA Paste below code in the Worksheet Code Module Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 'Variables to store drop down values Dim str_Location As String, str_Region As String Dim sli As SlicerItem If Application.Intersect(Target, Range("B1:C2")) Is Nothing Then Exit Sub If Sheet1.Range("B1").Value <> "Location" Then     Sheet1.Range("B1").Value = "Location" End If If Sheet1.Range("C1").Value <> "Region" Then     Sheet1.Range("C1").Value = "Region" End If str_Location = Sheet1.Range("B2").Value str_Region = Sheet1.Range("C2").Value If str_Location = "All" Then     Sheet2.PivotTables("ThisPivotTable1").Slicers("Location").SlicerCache.ClearAllFilters End If If str_Region = "All" Then     Sheet2.PivotTables("ThisPivotTable1").Slicers("Region").S...

Control Pivot Table Filters Using VBA

Control Pivot Table Filters Using VBA Paste below code in the Worksheet Code Module Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim str_Location As String, str_Region As String If Application.Intersect(Target, Range("B1:C2")) Is Nothing Then Exit Sub 'MsgBox "Yes, it intersect." If Sheet1.Range("B1").Value <> "Location" Then     Sheet1.Range("B1").Value = "Location" End If If Sheet1.Range("C1").Value <> "Region" Then     Sheet1.Range("C1").Value = "Region" End If str_Location = Sheet1.Range("B2").Value str_Region = Sheet1.Range("C2").Value If str_Location <> "All" Then     Sheet2.PivotTables("ThisPivotTable1").PivotFields("Location").ClearAllFilters     Sheet2.PivotTables("ThisPivotTable1").PivotFields("Location").CurrentPage = str_Location End If If str_Region <> ...

Paste Excel Range to Outlook Email Body Using Chart Object

 Paste Excel Range to Outlook Email Body Using Chart Object Option Explicit Sub PasteExcelRangeIntoChart() Dim ch As Chart Dim rng As Range For Each ch In ThisWorkbook.Charts     ch.Delete Next ch Set ch = Charts.Add Set ch = ch.Location(xlLocationAsObject, "Sheet1") ch.Parent.Name = "ABC" With Sheet1.Range("F3")     ch.Parent.Left = .Left     ch.Parent.Top = .Top End With With Sheet1.Range("B3:C9")     ch.Parent.Width = .Width     ch.Parent.Height = .Height End With Set rng = Sheet1.Range("B3:C9") rng.CopyPicture xlScreen, xlBitmap ch.Paste ch.Export ThisWorkbook.Path & "\ABC.png" Call SendEmail End Sub Sub SendEmail() Dim oApp As Object Dim oMail As Object Dim imgPath As String Set oApp = CreateObject("Outlook.Application") Set oMail = oApp.createitem(0) imgPath = ThisWorkbook.Path & "\ABC.png" With oMail     .display     .htmlbody = "<img src=""" & imgPath & "...