[Excel] Making Chart Series Invisible

'-----------------------------------------------------------------

'Make a Chart Series Invisible 
'----------------------------------------------------------------- 
'This macro loops through all he series of a selected chart 
'and for each series in the chart, it asks the user if they want 
'to make the series invisible 
'Making a series invisible simply means the following: 
'-Setting the Border as None 
'-Setting the Background Color as None 
'-Setting the Marker Type as None 
'For this macro to work properly, a chart has to be selected 
'Copyright: vbacentral.blogspot.com 
'----------------------------------------------------------------- 

Sub MakeSeriesInvisible()
  Dim s As Series
    For Each s In ActiveChart.SeriesCollection
      With s
        resp = MsgBox("Do you want to make series: " & Chr(34) & _
                       s.Name & Chr(34) & " invisible?", vbYesNo)
        If resp = vbYes Then 
          .Border.LineStyle = xlNone
          .MarkerBackgroundColorIndex = xlColorIndexNone
          .MarkerStyle = xlNone
        End If 
      End With 
    Next s
End Sub 

[Excel] Changing Chart Series Order

Here is a Bar Chart with Series 1 to 6. (bottom-up)

The data table is as shown below

If the series order required is: 5, 1, 3, 2, 6, 4 then enter the series names inside the code and select the chart and run the macro. The series order will be changed accordingly.

'--------------------------------------------------------------- 
'This macro changes the order of series in a collection of series 
'of a chart. The series names has to be hard coded inside this 
'code. 
'For this macro to work property 
'1. A chart should be selected 
'2. It should have more than 1 series 
'Copyright vbacentral.blogspot.com 
'--------------------------------------------------------------- 

Sub OrderFeesSeriesOfActiveChart()
 
  Dim sc As SeriesCollection
  Dim s As Series
  Dim LookupArray(6, 2) As Variant 
  Dim SeriesNameArray() As Variant 
  Dim OrderArray() As Variant 
  Dim Temp(1, 2) As Variant 
  Dim str, str1 As String 
  Dim SeriesCount, Count As Integer 
 
  Set sc = ActiveChart.SeriesCollection
  
  ' Count the number of series in the selected chart 
  Count = 0
  For Each s In sc
    If Trim(s.Name) <> "Total" Then Count = Count + 1
  Next s
  
  SeriesCount = Count
  
  ReDim SeriesNameArray(SeriesCount)
  ReDim OrderArray(SeriesCount, 2)
  
  ' Create 2x2 Lookup array with order wanted. 
  ' Hardcode the series names according to the desired order
  LookupArray(1, 1) = "Series 5"
  LookupArray(2, 1) = "Series 1"
  LookupArray(3, 1) = "Series 3"
  LookupArray(4, 1) = "Series 2"
  LookupArray(5, 1) = "Series 6"
  LookupArray(6, 1) = "Series 4"
  LookupArray(1, 2) = 1
  LookupArray(2, 2) = 2
  LookupArray(3, 2) = 3
  LookupArray(4, 2) = 4
  LookupArray(5, 2) = 5
  LookupArray(6, 2) = 6
 
   'Store series names in an array 
    For k = 1 To UBound(SeriesNameArray())
      SeriesNameArray(k) = Trim(sc(k).Name)
    Next k
    
   'Lookup series order from Lookup array 
    For i = 1 To UBound(LookupArray())
        For j = 1 To UBound(SeriesNameArray())
          If LookupArray(i, 1) = SeriesNameArray(j) Then 
            OrderArray(j, 1) = LookupArray(i, 1)
            OrderArray(j, 2) = LookupArray(i, 2)
            End If 
        Next j
    Next i
    
   'Sort the elements in OrderArray using order obtained from Lookup array 
    For i = 1 To SeriesCount - 1
      For j = i + 1 To SeriesCount
        If OrderArray(i, 2) > OrderArray(j, 2) Then 
          Temp(1, 1) = OrderArray(j, 1)
          Temp(1, 2) = OrderArray(j, 2)
          OrderArray(j, 1) = OrderArray(i, 1)
          OrderArray(j, 2) = OrderArray(i, 2)
          OrderArray(i, 1) = Temp(1, 1)
          OrderArray(i, 2) = Temp(1, 2)
        End If 
      Next j
    Next i
  'Assign new series order 
 
  For Each s In sc
      For i = 1 To SeriesCount
          If Trim(s.Name) = OrderArray(i, 1) Then 
              s.PlotOrder = i
          End If 
      Next i
  Next s
 
End Sub 

[Excel] Hiding/Unhiding sheets using an User Form

'************************************************************
' The code to call the Form should be written in Modules Section
'************************************************************
Sub HideUnhideSelectedSheets()
UserFormHideUnhide.Show
End Sub

' The Code to generate form should be written inside Forms section as shown below:
' Create a Form named "UserFormHideUnhide"

'************************************************************
'*** Code behind UserFormHideUnhide form
' - The form displays Visible and Invisible sheets
' side-by-side. The users can use the buttons to switch
' sheets between Hidden and Visible options
' - Once the user submits the form all the changes are
' applied to the sheets' visibility
'*** Names of the Controls on the UserForm
' Listbox: ListBox1 - displays a list of visible sheets
' Listbox: ListBox2 - displays a list of hidden sheets
' Button: MoveAllToRight - ">>" used to make all sheets
' but one hidden
' Button: MoveSelectedToRight - ">" hide one sheet at a time
' Button: MoveSelectedToLeft - "<" unhide one sheet at a time ' Button: MoveAllToLeft - ">>" used to make all sheets
' visible
' Button: Cancel - used to cancel the Form(dialog box)
' Button: Hide/Unhide - used to submit the UserForm
'************************************************************

'*** Initialize dialog box with Visible and Hidden sheets list

Private Sub UserForm_Initialize()

Dim sht As Variant
Dim shts As Sheets

For Each sht In ActiveWorkbook.Sheets
If sht.Visible Then
ListBox1.AddItem sht.Name
Else: ListBox2.AddItem sht.Name
End If
Next sht

End Sub

'*** Button to Hide all Visible sheets
Private Sub MoveAllToRight_Click()
'Add all but one Visible sheets into Hidden sheets list
For i = 1 To ListBox1.ListCount - 1
ListBox2.AddItem ListBox1.List(i)
Next i
'Remove all but one sheets from Visible sheets list
For i = 1 To ListBox1.ListCount - 1
ListBox1.RemoveItem (1)
Next i

MsgBox "At least one sheet should be visible"

End Sub

'***Button to hide selected visible sheets
Private Sub MoveSelectedToRight_Click()

Dim CountVisibleSheets, LastSelection, j As Integer
CountVisibleSheets = ListBox1.ListCount - 1

'Excel requires at least one sheet to be visible
If ListBox1.ListCount = 1 Then
LastSelection = 0
MsgBox "At least one sheet should be visible"
Else
'Add selected sheets to Hidden sheets listbox
For i = 0 To CountVisibleSheets
If ListBox1.Selected(i) Then
ListBox2.AddItem ListBox1.List(i)
End If
Next i

'Remove selected sheets from Visible sheets list
j = 0
Do Until j = ListBox1.ListCount
If ListBox1.Selected(j) Then
ListBox1.RemoveItem (j)
LastSelection = j
j = j - 1
End If
j = j + 1
Loop
End If

'Maintain a selection by moving selection to next visible sheet
If LastSelection < ListBox1.ListCount Then
ListBox1.Selected(LastSelection) = True
Else
ListBox1.Selected(LastSelection - 1) = True
End If

End Sub

'*** Button to Unhide selected Hidden sheets
Private Sub MoveSelectedToLeft_Click()
Dim CountVisibleSheets, LastSelection As Integer
CountVisibleSheets = ListBox2.ListCount - 1

For i = 0 To CountVisibleSheets
If ListBox2.Selected(i) Then
ListBox1.AddItem ListBox2.List(i)
End If
Next i

j = 0
Do Until j = ListBox2.ListCount
If ListBox2.Selected(j) Then
ListBox2.RemoveItem (j)
LastSelection = j
j = j - 1
End If
j = j + 1
Loop
'Maintain a selection by moving selection to next Hidden sheet
If LastSelection < ListBox2.ListCount Then
ListBox2.Selected(LastSelection) = True
ElseIf ListBox2.ListCount = 0 Then
Else
ListBox2.Selected(LastSelection - 1) = True
End If
End Sub

'*** Button to Unhide all Hidden sheets
Private Sub MoveAllToLeft_Click()
Dim CountHiddenSheets As Integer
CountHiddenSheets = ListBox2.ListCount - 1

For i = 0 To CountHiddenSheets
ListBox1.AddItem ListBox2.List(i)
Next i

For i = 0 To CountHiddenSheets
ListBox2.RemoveItem (0)
Next i
End Sub

'*** Cancel dialog button
Private Sub CommandCancel_Click()
Unload UserFormHideUnhide
End Sub

'*** Submit selection for hiding and unhiding sheets
Private Sub CommandHideUnhide_Click()
For i = 0 To ListBox1.ListCount - 1
ActiveWorkbook.Sheets(ListBox1.List(i)).Visible = True
Next i
For i = 0 To ListBox2.ListCount - 1
If i = ActiveWorkbook.Sheets.Count - 1 Then
MsgBox "At least one sheet should be visible"
Exit For
Else
ActiveWorkbook.Sheets(ListBox2.List(i)).Visible = False
End If
Next i
End Sub

Excel: Hide Unhide Comments

'-----------------------------------------------------------------
' Hide/Unhide Comments
' This macro toggles comments display
'-----------------------------------------------------------------
Sub ShowComments()

Application.DisplayCommentIndicator = Application.DisplayCommentIndicator * -1

End Sub

Excel: Toggle Hide Unhide data sheets

'--------------------------------------------------------------------------------
' Toggle Hide Unhide data sheets
' This macro creates an array of sheet names and upon running this macro
' will hide/unhide sheets
' Note: Atleast one sheet should be visible
'
'--------------------------------------------------------------------------------
Sub ToggleHideUnhideDataSheets()

Application.ScreenUpdating = False

Dim wb As Workbook
Dim ShtNames() As Variant

Set wb = ActiveWorkbook

ShtNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")

For i = 0 To UBound(ShtNames)
wb.Sheets(ShtNames(i)).Visible = Not wb.Sheets(ShtNames(i)).Visible
Next i

End Sub

Excel Charts: Change Chart Series Type from Bar to Line

'--------------------------------------------------------------------------
' Macro to change Chart Series type to Line
' For this macro to work properly a bar chart has to be selected
'--------------------------------------------------------------------------
Sub ChangeSeriesType_Bar_to_Line()
Dim s As Series
For Each s In ActiveChart.SeriesCollection
With s
resp = MsgBox("Do you want to change series: " & Chr(34) & _
s.Name & Chr(34) & " type from Bar to Line?", vbYesNo)
If resp = vbYes Then
.ChartType = xlLineMarkers
End If
End With
Next s
End Sub

Excel: Copy Range/Chart to PowerPoint

'**************************************************************************
' Copy Excel Range/Chart to PowerPoint
' This macro copies a range/chart from Excel to PowerPoint.
' 1. PowerPoint presentation should be opened for the macro to work properly
' 2. Macro asks for user input whether to copy a range or chart
' 3. Then asks whether to paste as Link as picture or link
' 4. It also makes sure the chart/range fits into PowerPoint slide by adjusting
' the height and width of pasted object.
'**************************************************************************
Sub Copy_Paste_to_PowerPoint()
'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide

Dim msg As String
Dim temp As Variant

Dim PasteChart As Boolean
Dim PasteChartLink As Boolean

Dim lHeight As Long
Dim lWidth As Long

'Look for existing instance of PowerPoint
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Sets current slide to active slide
Set ppSlide = ppApp.ActiveWindow.View.Slide

'Copy Range/Chart?
temp = MsgBox("Do you want to Copy-Paste Chart or Range? Yes=Chart ; No=Range", vbYesNo)
If temp = 6 Then
PasteChart = True
Else
PasteChart = False
End If

'Pasting a Chart
If PasteChart = True Then
Select Case TypeName(Selection)
'Paste Chart/Charts
Case "Chart", "ChartArea"
'Paste Chart as picture/link?
temp = MsgBox("Paste chart as a picture? Yes=Picture ; No=Link", vbYesNo)
If temp = 7 Then
PasteChartLink = True
Else
PasteChartLink = False
End If
'Copy Paste action
If PasteChartLink = True Then
'Copy & Paste Chart Linked
'ActiveChart.ChartArea.Copy
Selection.Copy
ppSlide.Shapes.PasteSpecial(link:=True).Select
Else
'Copy & Paste Chart Not Linked
'ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
'ppSlide.Shapes.Paste.Select
Selection.Copy
ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Select
End If
'Paste DrawingObjects (Multiple charts/drawing objects)
Case "DrawingObjects"
Selection.Copy
ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Select
Case Else
msg = MsgBox("Select a Chart and run macro", vbOKOnly, "Select a Chart")
'End Sub
End Select
'Pasting a Range
Else
'Paste Chart as picture/link?
temp = MsgBox("Paste Range as a picture? Yes=Picture ; No=Link", vbYesNo)
If temp = 7 Then
PasteRangeLink = False
Else
PasteRangeLink = True
End If
'Options for Copy & Paste Ranges
If RangePasteType = True Then
'Paste Range as Picture
'Worksheets(SheetName).Range(RangeName).Copy
Selection.Copy
ppSlide.Shapes.PasteSpecial(ppPasteMetafilePicture).Select
Else
'Paste Range as Picture Link
'Worksheets(SheetName).Range(RangeName).Copy
Selection.Copy
ppSlide.Shapes.PasteSpecial(ppPasteMetafilePicture, link:=msoTrue).Select
End If
End If


' Get the slide height and width.
lHeight = ppApp.ActivePresentation.PageSetup.SlideHeight
lWidth = ppApp.ActivePresentation.PageSetup.SlideWidth

' Set Height & Width of pasted object to fit the slide
If ppApp.ActiveWindow.Selection.ShapeRange.Height > lHeight Then
ppApp.ActiveWindow.Selection.ShapeRange.Height = lHeight
End If
If ppApp.ActiveWindow.Selection.ShapeRange.Width > lWidth Then
ppApp.ActiveWindow.Selection.ShapeRange.Width = lWidth
End If

' Center pasted object in the slide
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

' Activate PowerPoint window
AppActivate ("Microsoft PowerPoint")
Set ppSlide = Nothing
Set ppApp = Nothing

End Sub

PowerPoint: Changing Layout of all slides

'*************************************************************
' Changing Slide Layout
' This macro changes the layout of slides in the range stated
' by counter.
' For a list of Layout types (enumerations) check out the
' Enumerations topic
'*************************************************************

Sub ChangeSlideLayout()

For i = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Layout = ppLayoutTitleOnly

Next i

End Sub

PowerPoint: Resizing all the Shapes of a particular shape type

'*************************************************************
' Resizing all the Shapes of a particular shape type.
' This example sets the height and width of all charts which
' were pasted from Excel into PowerPoint as Linked charts
' This example can be used to format other shape types by
' changing the msoShapeType enumeration.
' For a list of Shape types (enumerations) check out the
' Enumerations topic
'*************************************************************

Sub SetLinkedChartSize()
Dim s As Slide
Dim shp As Shape

For Each s In ActivePresentation.Slides
For Each shp In s.Shapes
If shp.Type = msoLinkedOLEObject Then
With shp
.LockAspectRatio = msoFalse
.Height = 255
.Width = 400
End With
End If
Next shp
Next s

End Sub

PowerPoint: Formating Slide Titles on all slides

'*************************************************************
' Formating Slide Titles on all slides
' This macro formats the position, Font name and Font size of
' titles on all slides of active presentation
'*************************************************************
Sub FormatSlideTitles()
Dim s As Slide
Dim shp As Shape

For Each s In ActivePresentation.Slides
For Each shp In s.Shapes
If shp.Type = msoPlaceholder Then
With shp
.Top = 5
.TextFrame.TextRange.Font.Name = "Times New Roman"
.TextFrame.TextRange.Font.Size = 24
End With
End If
Next shp
Next s

End Sub

PowerPoint: Update Links to Excel charts and ranges

'*************************************************************
'Updating all links of OLE objects embedded in PowerPoint
'This macro is intended to Update charts/Ranges that are
'copy-pasted from Excel into PowerPoint using "Paste Link"
[option of Paste Special menu item
'The macro updates all links in the PowerPoint
'*************************************************************
Sub Update_Links()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then oshp.LinkFormat.Update
Next oshp
Next osld
End Sub

PowerPoint: Resizing Height and Width of selected shapes

'**************************************************************
' Setting the size (Width x Height) of selected shapes with user
' input
' For this macro to work properly, you need to select one or
' more shapes.
' The macro asks for user input to enter Width and Height
' By default, the Input box displays maximum height and width
' of all the selected shapes
'**************************************************************
Sub Resize_Selected_Shapes()

Dim shp As Shape
Dim BoxWidth, BoxHeight As Integer

If ActiveWindow.Selection.Type = ppSelectionNone Then
MsgBox "Please select objects to resize", vbExclamation, "Make Selection"
Else
' 1st Pass - get the desired width & height
For Each shp In ActiveWindow.Selection.ShapeRange
If shp.Width > MaxWidth Then MaxWidth = shp.Width
If shp.Height > MaxHeight Then MaxHeight = shp.Height
Next shp

'Get the desired box dimensions - set default as max width & max height
BoxWidth = InputBox("Enter the required Width " & Chr(10) & _
"(Default is Largest Width of selected boxes)", "Box Width", MaxWidth)
BoxHeight = InputBox("Enter the required Height " & Chr(10) & _
"(Default is Largest Width of selected boxes)", "Box Height", MaxHeight)

' 2nd pass - change the sizes
For Each shp In ActiveWindow.Selection.ShapeRange
shp.LockAspectRatio = msoFalse
shp.Width = BoxWidth
shp.Height = BoxHeight
Next shp
End If

End Sub

Word: Copying a Range of Cells from Excel into Word

'----------------------------------------------------------------------
' Copying a Range of Cells from Excel into Word
'----------------------------------------------------------------------
Sub CopyXLRangeIntoWord()

Dim strData As String
Dim lngChannel As Long
Dim r As Range
Dim str As String
Dim strFilePath As String
Dim strFileName As String

str = "R1C1: R21C7" 'Specify the Excel range you want to copy
strFilePath = "C:\temp\test.xls"
strFileName = "test.xls"

'Open a dynamic data exchange (DDE) channel to Excel Application
lngChannel = DDEInitiate(App:="Excel", Topic:="System")

'Send OPEN command to Excel through initiated channel
DDEExecute Channel:=lngChannel, Command:="[OPEN(" & Chr(34) _
& strFilePath & Chr(34) & ")]"

'Send COPY command to Excel through initiated channel
DDEExecute Channel:=lngChannel, Command:="[COPY(" & Chr(34) _
& "R1C1:R21C7" & Chr(34) & ")]"

'Close the DDE channel to Excel
DDETerminate Channel:=lngChannel

lngChannel = DDEInitiate(App:="Excel", Topic:=strFileName)

'Request information from Excel
strData = DDERequest(Channel:=lngChannel, Item:=str)
'Terminate all channels to Excel
DDETerminateAll

'Paste Excel range into Word Document
'To Paste as text in the beginning of Word document:
ActiveDocument.Range.InsertBefore strData
' To Paste as Picture in the beginning of Word Document:
'ActiveDocument.Range(End:=0).PasteSpecial DataType:=wdPasteEnhancedMetafile

End Sub