Please modify PPT Macro - powerpoint

Question

I have below macro.
Could you please modify it in such ways that it will show slide number on the top and also extract notes page.
I tried all ways but couldn't get answer-:
Sub WriteToWord()
Dim aSlide As Slide, MyDoc As New Word.Document, MyRange As Word.Range
Dim aTable As Table, aShape As Shape, TablesCount As Integer, ShapesCount As Integer
Dim i As Word.Paragraph
On Error Resume Next
With MyDoc
.Application.Visible = False
.Application.ScreenUpdating = False
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
Set MyRange = .Range(.Content.End - 1, .Content.End - 1)
Select Case aShape.Type
Case msoAutoShape, msoPlaceholder, msoTextBox
If aShape.TextFrame.HasText Then
aShape.TextFrame.TextRange.Copy
MyRange.Paste
With MyRange
.ParagraphFormat.Alignment = wdAlignParagraphLeft
For Each i In MyRange.Paragraphs
If i.Range.Font.Size >= 16 Then
i.Range.Font.Size = 14
Else
i.Range.Font.Size = 12
End If
Next
End With
End If
Case msoPicture
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteMetafilePicture
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoLinkedPicture, msoOLEControlObject
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteOLEObject
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoTable
aShape.Copy
MyRange.Paste
TablesCount = .Tables.Count
With .Tables(TablesCount)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Range.Font.Size = 11
End With
.Content.InsertAfter Chr(13)
End Select
Next
If aSlide.SlideIndex < ActivePresentation.Slides.Count Then .Content.InsertAfter Chr(12)
.UndoClear ' Clear used memory
Next
' Change white font to black color
With .Content.Find
.ClearFormatting
.Format = True
.Font.Color = wdColorWhite
.Replacement.Font.Color = wdColorAutomatic
.Execute Replace:=wdReplaceAll
End With
MsgBox "PPT Converted to WORD completed, Please check and save document", vbInformation + vbOKOnly, "ExcelHome/ShouRou"
.Application.Visible = True
.Application.ScreenUpdating = True
End With
End Sub
Sub Auto_Open() ' Add PPTtoWord to Tool Bar when Powerpoint start
Dim MyControl As CommandBarControl
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
Set MyControl = Application.CommandBars("Standard").Controls.Add(Before:=1)
With MyControl
.Caption = "PPTtoWord"
.FaceId = 567 ' Word Icon
.Enabled = True
.Visible = True
.Width = 100
.OnAction = "WriteToWord"
.Style = msoButtonIconAndCaption
End With
End Sub
Sub Auto_Close() ' Delete PPTtoWord from Tool Bar when Powerpoint close
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
End Sub

Answer 1

You are running this from Word and automating PowerPoint using early binding, you need to fully qualify any PowerPoint reference.
Have you added a reference to PowerPoint library.
Change to aShape As PowerPoint.Shape
Grab the reference to the running instance of PowerPoint. PowerPoint is single instance multi-use so you can use this.
Dim PPT as PowerPoint.Application
Set PPT = CreateObject("PowerPoint.Application")
Fully qualify all references to ActivePresentation with PPT.ActivePresentation
Your macro should run then and generate something so that you can continue debugging.