microsoft.public.word.vba.general

Option Explicit

Private Sub CommandButton1_Click()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim tr As HTMLTableRow
Dim td As HTMLTableCell
Dim tbl As HTMLTable
Dim blc As HTMLBlockElement
Dim doctbl As Table
Dim nrow As Integer

Dim A As Integer
Dim NavPages As Variant
Dim Temp$

Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = False
'***** This sets the web page to access:
'Premier
Temp$ = "http://www.skysports.com/football/league/
0,19540,11660,00.html;" & _
"http://www.skysports.com/football/league/0,19540,11687,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11718,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11749,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11780,00.html"
NavPages = Split(Temp$, ";")

For A = 0 To UBound(NavPages)

ie.Navigate NavPages(A)

' ie.navigate "http://www.skysports.com/football/league/
0,19540,11660,00.html"

'Championship
' ie.navigate "http://www.skysports.com/football/league/
0,19540,11687,00.html"

'League1
' ie.Navigate "http://www.skysports.com/football/league/
0,19540,11718,00.html"

'League2
'ie.navigate "http://www.skysports.com/football/league/
0,19540,11749,00.html"

'Scottish Premier
'ie.navigate "http://www.skysports.com/football/league/
0,19540,11780,00.html"
Do

MsgBox "Looking up data on Skysports...", , "Collecting Data"

'***** MC - wait until internet page has completed loading
DoEvents
Loop While ie.readyState <> READYSTATE_COMPLETE

Set doc = ie.Document

'this searches for the element name - eg table id="ss-stat-sort"
Set tbl = doc.getElementById("ss-stat-sort")

'"ss-stat-sort" is the html code on this page

nrow = tbl.Rows.Length - 1

'this looks for the tag " in the html code
Set blc = tbl.all.tags("caption").Item(0)

'***** MC - insert the table title bar
'outerText = Returns or sets a String that represents the text,
'without any HTML, of a DIV element
ActiveDocument.Range.InsertAfter blc.outerText

Dim myrange As Range
Set myrange = ActiveDocument.Content
myrange.Collapse direction:=wdCollapseEnd

'***** MC - this part selects for 10 columns
Set doctbl = ActiveDocument.Tables.Add(myrange, nrow, 10)

Dim i As Integer, x As Integer

'***** MC - select no of teams to show from the top - for top 10 type
-11 here,
' else type -1 default
x = tbl.Rows.Length - 1

Dim col As Integer, j As Integer
For i = 2 To x
Set tr = tbl.all.tags("tr").Item(i)
col = tr.all.tags("td").Length - 2
For j = 2 To col
Set td = tr.all.tags("td").Item(j)
doctbl.Cell(i, j).Range.Text = td.outerText
Next
DoEvents

'***** MC - above code inserts the data for first row - the 'next'
code
'below loops through rest of the rows and repeats

Next

ActiveDocument.Tables(1).Columns(2).Select

'now look through all football team names and shorten as required

'Manchester > Man
'United > Utd
'Rovers > -
'Hotspur > -
'Wanderers > -
'Wolverhampton Wanderers > Wolves
'Athletic > -
'Birmingham City > Birmingham


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Manchester"
.Replacement.Text = "Man"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "United"
.Replacement.Text = "Utd"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rovers"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Hotspur"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Wolverhampton Wanderers"
.Replacement.Text = "Wolves"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Athletic"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Birmingham City"
.Replacement.Text = "Birmingham"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Dagenham & Redbridge"
.Replacement.Text = "Dagenham & R"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rotherham United"
.Replacement.Text = "Rotherham"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Rotherham Utd"
.Replacement.Text = "Rotherham"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Accrington Stanley"
.Replacement.Text = "Accrington S"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Shrewsbury Town"
.Replacement.Text = "Shrewsbury"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Macclesfield Town"
.Replacement.Text = "Macclesfield"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Mansfield Town"
.Replacement.Text = "Mansfield"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Peterborough Utd"
.Replacement.Text = "Peterborough"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Dons"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " County"
.Replacement.Text = " C"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "West Bromwich Albion"
.Replacement.Text = "WBA"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Argyle"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Queens Park Rangers"
.Replacement.Text = "QPR"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " North End"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Wednesday"
.Replacement.Text = "Wed"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = " C"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Inverness Caledonian Thistle"
.Replacement.Text = "Inverness"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Town"
.Replacement.Text = "T"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "and Hove Albion"
.Replacement.Text = "& H"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Nottingham Forest"
.Replacement.Text = "Notts Forest"
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Alexandra"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue


End With
Selection.Find.Execute Replace:=wdReplaceAll


'***** MC - this sets the column width for the second column (eg the
team name)
' doctbl.Columns(2).Width = 140


'***** MC - this sets the column width for the remaining columns (eg
the data)
'For i = 3 To 10
'doctbl.Columns(i).Width = 30
'Next


Selection.HomeKey Unit:=wdStory


ActiveDocument.Tables(1).Columns(1).Delete


'Insert the header titles
ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range.Select
Selection.TypeText "Team"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=2).Range.Select
Selection.TypeText "Pld"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range.Select
Selection.TypeText "W"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=4).Range.Select
Selection.TypeText "D"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=5).Range.Select
Selection.TypeText "L"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=6).Range.Select
Selection.TypeText "GF"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=7).Range.Select
Selection.TypeText "GA"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=8).Range.Select
Selection.TypeText "GD"
ActiveDocument.Tables(1).Cell(Row:=1, Column:=9).Range.Select
Selection.TypeText "Pts"


Selection.Rows(1).Select
Selection.Font.Bold = wdToggle


Selection.Tables(1).Select
Selection.Font.Size = 6


ActiveDocument.Tables(1).Columns(1).Width = 40


For i = 3 To 9
'doctbl.Columns(i).Width = 10


' ActiveDocument.Tables(1).Columns(i).Width = 5
Next


'
' This part converts table to text then sets columns


Selection.Rows.ConvertToText Separator:=wdSeparateByTabs,
NestedTables:= _
True
CommandBars("Control Toolbox").Visible = False

Selection.ParagraphFormat.TabStops(CentimetersToPoints(2.97)).Position
= _
CentimetersToPoints(1.9)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(4.53)).Position
= _
CentimetersToPoints(2.54)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(6.1)).Position
= _
CentimetersToPoints(3.17)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(7.66)).Position
= _
CentimetersToPoints(3.81)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(9.22)).Position
= _
CentimetersToPoints(4.44)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(10.78)).Position
= _
CentimetersToPoints(5.08)

Selection.ParagraphFormat.TabStops(CentimetersToPoints(12.35)).Position
= _
CentimetersToPoints(5.71)
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle


Selection.Find.ClearFormatting


' This part looks for the title and then neatens it up


Selection.Find.ClearFormatting
With Selection.Find
.Text = "Team"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.EndKey Unit:=wdLine


With ActiveDocument.Range
.Collapse wdCollapseEnd
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
End With


Next A

MsgBox "End of macro..."
End Sub