1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
|
Private Sub collecterInfos()
Dim xlApp As excels.Application
Dim xlClasseur As excels.Workbook
Dim xlFeuill As excels.Worksheet
Dim siteWeb As String
Dim chaine As Integer
Dim myProcesses() As Process
Dim myProcess As Process
Dim misvalue As Object = System.Reflection.Missing.Value
xlApp = CreateObject("Excel.Application")
xlClasseur = xlApp.Workbooks.Add ' Ajout d'un classeur
xlFeuill = xlClasseur.Worksheets(1) ' Ajout d'une feuille
' Modification de la chaine dans le cas où l'index de la combo est supérieur à 2
' Car sur le site d'où proviennent mes infos les index sont incrémentés 1, 2, 10, 11, 12, 13,... (saut de 2 à 10)
If cboChaine.SelectedIndex > 2 Then
chaine = cboChaine.SelectedIndex + 8
Else
chaine = cboChaine.SelectedIndex + 1
End If
' Construction de l'URL
' REM : recherche des infos sur le site de la TSR
siteWeb = "http://www.tsr.ch/tsr/index.html?siteSect=601000&idChaine=" & chaine & "&jourD=" & cboJour.Text & "&Ftime=1"
xlApp.UserControl = True
Dim oldCI As System.Globalization.CultureInfo = _
System.Threading.Thread.CurrentThread.CurrentCulture
System.Threading.Thread.CurrentThread.CurrentCulture = _
New System.Globalization.CultureInfo("en-US")
xlApp.Workbooks.Add()
System.Threading.Thread.CurrentThread.CurrentCulture = oldCI
xlApp = New excels.ApplicationClass
xlClasseur = xlApp.Workbooks.Add(misvalue)
xlFeuill = xlClasseur.Sheets("sheet1")
' Macro qui va rechercher les infos sur le site Web
With xlFeuill.QueryTables.Add("URL;" & siteWeb & "", xlFeuill.Range("A1"))
.Name = "index.html?siteSect=601000&jourD=" & cboJour.Text & "&Ftime=1&idChaine=" & chaine & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = excels.XlCellInsertionMode.xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = excels.XlWebSelectionType.xlSpecifiedTables
.WebFormatting = excels.XlWebFormatting.xlWebFormattingNone
.WebTables = "39"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh(BackgroundQuery:=False)
End With
' Sélection des cellules dont on a besoin
txtHoraire.Text = xlFeuill.Range("B3").Text
txtTitre.Text = xlFeuill.Range("C3").Text
txtRemarque.Text = xlFeuill.Range("B5").Text
Dim ch As String
Dim SaveFileDialog1 As New SaveFileDialog()
Dim result As DialogResult = SaveFileDialog1.ShowDialog()
If (result = Windows.Forms.DialogResult.OK) Then
ch = SaveFileDialog1.FileName
xlFeuill.SaveAs(ch)
xlApp.Application.Quit()
End If
' Contrôle des process
' Si un process EXCEL tourne encore je le flingue...
myProcesses = Process.GetProcesses()
For Each myProcess In myProcesses
If UCase(myProcess.ProcessName) = "EXCEL" Then
myProcess.Kill()
End If
Next
End Sub |
Partager