'
' Macro1 Macro
' Macro enregistrée le 05/04/2020 par ROLAND
'
'
Sheets("PageRecup").Cells.Clear
Sheets("Code").Select
Dim i As Integer
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim InputWPZoneTexte As HTMLInputElement
Dim InputWPBouton As HTMLInputElement
Dim InputWPSave As Object
Ligne = 1
LigneRef = 114
LigneGeoloc = 50
LigneComEval = 60
LigneComRattach = 60
BureauCentr = Sheets("Code").Cells(23, 6)
iDebut = Sheets("Code").Cells(30, 2)
iFin = Sheets("Code").Cells(31, 2)
For i = iDebut To iFin
Sheets("Code").Cells(2, 3) = i
NbCantons = 1
Sheets("Code").Cells(6, 2) = Sheets("COM2020").Cells(i, 1)
Sheets("Code").Cells(7, 2) = Sheets("COM2020").Cells(i, 3)
Sheets("Code").Cells(8, 2) = Sheets("COM2020").Cells(i, 4)
Sheets("Code").Cells(9, 2) = Sheets("COM2020").Cells(i, 5)
Sheets("Code").Cells(10, 2) = Sheets("COM2020").Cells(i, 7)
Sheets("Code").Cells(11, 2) = Sheets("COM2020").Cells(i, 8)
Sheets("Code").Cells(12, 2) = Sheets("COM2020").Cells(i, 9)
Sheets("Code").Cells(13, 2) = Sheets("COM2020").Cells(i, 10)
Sheets("Code").Cells(14, 2) = Sheets("COM2020").Cells(i, 11)
Sheets("Code").Cells(16, 2) = Sheets("COM2020").Cells(i, 13)
Sheets("Code").Cells(17, 2) = Sheets("COM2020").Cells(i, 14)
Sheets("Code").Cells(22, 2) = Sheets("COM2020").Cells(i, 15)
CodeDEP = Sheets("Code").Cells(12, 2) ' recherche nom Dep
For k = 2 To 101
If Sheets("DEP").Cells(k, 2) = CodeDEP Then
Sheets("Code").Cells(12, 3) = Sheets("DEP").Cells(k, 5)
Sheets("Code").Cells(12, 4) = Sheets("DEP").Cells(k, 8)
Sheets("Code").Cells(12, 5) = Sheets("DEP").Cells(k, 3)
Sheets("Code").Cells(23, 2) = Sheets("DEP").Cells(k, 11)
k = 101
End If
Next k
CodeREG = Sheets("Code").Cells(13, 2) ' recherche nom région
For k = 2 To 19
If Sheets("REGION").Cells(k, 1) = CodeREG Then
Sheets("Code").Cells(13, 3) = Sheets("REGION").Cells(k, 4)
Sheets("Code").Cells(27, 3) = Sheets("REGION").Cells(k, 5)
k = 19
End If
Next k
CodeEPCI = Sheets("Code").Cells(14, 2) ' recherche nom EPCI
For k = 1 To 1255
If Sheets("EPCI2020").Cells(k, 1) = CodeEPCI Then
Sheets("Code").Cells(14, 3) = Sheets("EPCI2020").Cells(k, 7)
Sheets("Code").Cells(14, 4) = Sheets("EPCI2020").Cells(k, 8)
Sheets("Code").Cells(14, 5) = Sheets("EPCI2020").Cells(k, 11)
Sheets("Code").Cells(15, 2) = Sheets("EPCI2020").Cells(k, 16)
Sheets("Code").Cells(15, 3) = Sheets("EPCI2020").Cells(k, 14)
Sheets("Code").Cells(15, 4) = Sheets("EPCI2020").Cells(k, 4)
Sheets("Code").Cells(15, 5) = Sheets("EPCI2020").Cells(k, 15)
k = 1255
End If
Next k
CodeARR = Sheets("Code").Cells(16, 2) ' recherche nom arrondissement
For k = 1 To 332
If Sheets("ARR").Cells(k, 1) = CodeARR Then
Sheets("Code").Cells(16, 3) = Sheets("ARR").Cells(k, 4)
Sheets("Code").Cells(16, 4) = Sheets("ARR").Cells(k, 3)
Sheets("Code").Cells(16, 5) = Sheets("ARR").Cells(k, 5)
Sheets("Code").Cells(7, 5) = Sheets("ARR").Cells(k, 2)
k = 332
End If
Next k
CodeCANTON = Sheets("Code").Cells(17, 2) ' recherche nom canton
For k = 1 To 2055
If Sheets("CANTON").Cells(k, 1) = CodeCANTON Then
Sheets("Code").Cells(17, 3) = Sheets("CANTON").Cells(k, 4)
Sheets("Code").Cells(17, 4) = Sheets("CANTON").Cells(k, 5)
Sheets("Code").Cells(17, 5) = Sheets("CANTON").Cells(k, 11)
k = 2055
End If
Next k
For k = 1 To 2353 ' recherche nom du bureau centralisateur du canton
If Sheets("CANTON-BC").Cells(k, 8) = Sheets("Code").Cells(20, 2) Then
Sheets("Code").Cells(18, 4) = Sheets("CANTON-BC").Cells(k, 6)
k = 2353
End If
Next k
CodeInsee = Sheets("Code").Cells(6, 2) ' recherche nom circonscription
For k = 1 To 37536
If Sheets("CIRC").Cells(k, 1) = CodeInsee Then
Sheets("Code").Cells(19, 2) = Sheets("CIRC").Cells(k, 5)
k = 37536
End If
Next k
CodeCIRC = Sheets("Code").Cells(19, 3)
For k = 1 To 577
If Sheets("CIRC-Liste").Cells(k, 3) = CodeCIRC Then
Sheets("Code").Cells(19, 4) = Sheets("CIRC-Liste").Cells(k, 4)
Sheets("Code").Cells(19, 5) = Sheets("CIRC-Liste").Cells(k, 5)
k = 577
End If
Next k
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXX RECUPERATION des données Meta en cas de cantons multiples XXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' https://www.insee.fr/fr/metadonnees/cog/commune/COM01015-arboys-en-bugey
If Sheets("Code").Cells(18, 2) > 70 Then
Sheets("PageRecup").Cells.Clear
CodeMeta = Sheets("Code").Cells(22, 2)
With Sheets("PageRecup").QueryTables.Add(Connection:= _
"URL;https://www.insee.fr/fr/metadonnees/cog/commune/COM" & CodeInsee & "-" & CodeMeta, Destination:=Sheets("PageRecup").Range("A1"))
.Name = "index"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
a = 16
For Ligne = 100 To 300
If Left(Sheets("PageRecup").Cells(Ligne, 1), 11) = "Canton(s) :" Then
LigneDeb = Ligne
Ligne = 300
End If
Next Ligne
Range("G17:G27").Select
Selection.Clear
Range("C18:C18").Select
Selection.Clear
For k = 1 To 5
If Sheets("PageRecup").Cells(LigneDeb + k, 1) <> "" Then
a = a + 1
Sheets("Code").Cells(a, 7) = Sheets("PageRecup").Cells(LigneDeb + k, 1)
Else
NbCantons = k - 1
k = 5
End If
Next k
Sheets("Code").Cells(18, 3) = NbCantons
'MsgBox (NbCantons)
For k = 1 To NbCantons
Pos1 = InStr(Sheets("Code").Cells(16 + k, 7), "(")
Sheets("Code").Cells(16 + k, 9) = Left(Sheets("Code").Cells(16 + k, 7), Pos1 - 2)
Pos2 = InStr(Sheets("Code").Cells(16, 7), ")")
Sheets("Code").Cells(16 + k, 10) = Mid(Sheets("Code").Cells(16 + k, 7), Pos1 + 1, 4)
Next k
For k = 1 To NbCantons
For a = 1 To 2055
If Sheets("Code").Cells(16 + k, 10) = Sheets("CANTON").Cells(a, 1) Then
Sheets("Code").Cells(16 + k, 11) = Sheets("CANTON").Cells(a, 5)
Sheets("Code").Cells(16 + k, 12) = Sheets("CANTON").Cells(a, 6)
a = 2055
End If
Next a
Next k
End If
NomWPCommune = Sheets("Code").Cells(8, 2)
NomCodeCommune = Sheets("Code").Cells(9, 2)
CodeArticle = Sheets("Code").Cells(25, 2)
CommuneNouvelle = Sheets("Code").Cells(24, 2)
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXX RECUPERATION TEXTEWP de l'article de la commune XXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
IE.Navigate "https://fr.wikipedia.org/w/index.php?title=" & NomCodeCommune & "&action=edit"
IE.Visible = False
WaitIE IE
Set IEDoc = IE.Document
Set InputWPZoneTexte = IEDoc.all("wpTextbox1")
Set InputWPResume = IEDoc.all("wpSummary")
TexteWP = InputWPZoneTexte.Value
jfin = Len(TexteWP)
'MsgBox (jfin)
' XXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXX Actualisation Infobox XXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXX Recherche éventuelles références
For j = 1 To jfin
If Mid(TexteWP, j, 7) = "Infobox" Then
ka = j
Infoboxa = 1
j = jfin
End If
Next j
If Infoboxa = 1 Then
For j = ka To jfin
If Mid(TexteWP, j, 2) = "}}" Then
kb = j
j = jfin
End If
Next j
For j = ka To kb
If Mid(TexteWP, j, 4) = "<ref" Then
LigneRef = LigneRef + 1
Sheets("Code").Cells(LigneRef, 10) = Sheets("Code").Cells(6, 2)
Sheets("Code").Cells(LigneRef, 11) = Sheets("Code").Cells(7, 2)
GoTo FinCode
j = kb
End If
Next j
End If
' XXXXXXX Intercommunalité
TestInfobox = 0
TestGeoloc = 0
InfoboxTest = 0
Txt1 = Chr(10) & "|intercomm"
Txt2 = Chr(10) & " | intercomm"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & "| intercomm"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & " |intercomm"
TexteWP = Replace(TexteWP, Txt1, Txt2)
InfoboxIntercom = 0
For j = 1 To jfin
If Mid(TexteWP, j, 11) = "| intercomm" Then
k0 = j
InfoboxIntercom = 1
j = jfin
End If
Next j
If InfoboxIntercom = 1 Then
For j = k0 To jfin
If Mid(TexteWP, j, 1) = "=" Then
kDeb = j + 1
j = jfin
End If
Next j
For j = kDeb To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin = j
j = jfin
End If
Next j
TxtIntercomm1 = Mid(TexteWP, k0, kFin - k0)
' If Left(TxtIntercomm1, 1) <> " " Then
' TxtIntercomm1 = " " & TxtIntercomm1
' End If
If Sheets("Code").Cells(7, 2) = Sheets("Code").Cells(15, 5) Then ' test si la commune est siège de l'intercom
TxtIntercomm2 = Sheets("Code").Cells(58, 1) & " " & Sheets("Code").Cells(14, 4) & Sheets("Code").Cells(24, 6)
Else
TxtIntercomm2 = Sheets("Code").Cells(58, 1) & " " & Sheets("Code").Cells(14, 4)
End If
TexteWP = Replace(TexteWP, TxtIntercomm1, TxtIntercomm2)
End If
' XXXXXXX Canton
Txt1 = Chr(10) & "|canton"
Txt2 = Chr(10) & " | canton"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & "| canton"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & " |canton"
TexteWP = Replace(TexteWP, Txt1, Txt2)
InfoboxCanton = 0
For j = 1 To jfin
If Mid(TexteWP, j, 8) = "| canton" Then
k0 = j
InfoboxCanton = 1
j = jfin
End If
Next j
If InfoboxCanton = 1 Then
For j = k0 To jfin
If Mid(TexteWP, j, 1) = "=" Then
kDeb = j + 1
j = jfin
End If
Next j
For j = kDeb To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin = j
j = jfin
End If
Next j
TxtCanton1 = Mid(TexteWP, k0, kFin - k0)
If NbCantons = 1 Then
If Sheets("Code").Cells(18, 4) = Sheets("Code").Cells(7, 2) Then
TxtCanton2 = Sheets("Code").Cells(52, 1) & " " & Sheets("Code").Cells(17, 5) & BureauCentr ' test si la commune est bureau centralisateur du canton
Else
TxtCanton2 = Sheets("Code").Cells(52, 1) & " " & Sheets("Code").Cells(17, 5)
End If
Else
If Sheets("Code").Cells(18, 4) = Sheets("Code").Cells(7, 2) Then
TxtCanton2 = Sheets("Code").Cells(52, 1) & " " & "Bureau centralisateur des cantons de "
Else
TxtCanton2 = Sheets("Code").Cells(52, 1) & " " & "Cantons de "
End If
For a = 1 To NbCantons - 1
If NbCantons > 2 Then
TxtCanton2 = TxtCanton2 & Sheets("Code").Cells(16 + a, 11) & ", de "
Else
TxtCanton2 = TxtCanton2 & Sheets("Code").Cells(16 + a, 11)
End If
Next a
TxtCanton2 = TxtCanton2 & " et de " & Sheets("Code").Cells(16 + NbCantons, 11)
End If
TexteWP = Replace(TexteWP, TxtCanton1, TxtCanton2)
End If
jfin = Len(TexteWP)
' XXXXXXX Circonscription législative
InfoboxCirc = 0
For j = 1 To jfin
If Mid(TexteWP, j, 29) = "| circonscription législative" Then
k0 = j
InfoboxCirc = 1
j = jfin
End If
Next j
If InfoboxCirc = 0 Then
Txt1 = TxtCanton2
TxtCirc = TxtCanton2 & Chr(10) & Sheets("Code").Cells(29, 10)
TexteWP = Replace(TexteWP, Txt1, TxtCirc)
jfin = Len(TexteWP)
End If
' XXXXXXX Arrondissement
Txt1 = Chr(10) & "|arron"
Txt2 = Chr(10) & " | arron"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & "| arron"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & " |arron"
TexteWP = Replace(TexteWP, Txt1, Txt2)
InfoboxArron = 0
For j = 1 To jfin
If Mid(TexteWP, j, 16) = "| arrondissement" Then
k0 = j
InfoboxArron = 1
j = jfin
End If
Next j
If InfoboxArron = 1 Then
For j = k0 To jfin
If Mid(TexteWP, j, 1) = "=" Then
kDeb = j + 1
j = jfin
End If
Next j
For j = kDeb To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin = j
j = jfin
End If
Next j
TxtArron1 = Mid(TexteWP, k0, kFin - k0)
TxtArron2 = Sheets("Code").Cells(51, 1) & Sheets("Code").Cells(16, 5)
If Sheets("Code").Cells(7, 5) = Sheets("Code").Cells(7, 2) Then
TxtArron2 = Sheets("Code").Cells(51, 1) & " " & Sheets("Code").Cells(16, 5) & "<br/><small>([[chef-lieu]])</small>"
Else
TxtArron2 = Sheets("Code").Cells(51, 1) & " " & Sheets("Code").Cells(16, 5)
End If
TexteWP = Replace(TexteWP, TxtArron1, TxtArron2)
End If
jfin = Len(TexteWP)
' XXXXXXX Géoloc
Txt1 = Chr(10) & "|géoloc"
Txt2 = Chr(10) & " | géoloc"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & "| géoloc"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & " |géoloc"
TexteWP = Replace(TexteWP, Txt1, Txt2)
InfoboxGeoloc = 0
For j = 1 To jfin
If Mid(TexteWP, j, 20) = "| géoloc-département" Then
InfoboxGeoloc = 1
k0 = j
j = jfin
End If
Next j
If InfoboxGeoloc = 1 Then ' Cas où il y a un paramètre de géolocalisation
For j = k0 To jfin
If Mid(TexteWP, j, 1) = "=" Then
kDeb = j + 1
j = jfin
End If
Next j
For j = kDeb To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin = j
j = jfin
End If
Next j
TxtGeoloc1 = Mid(TexteWP, k0, kFin - k0)
PosAccolade = 0 ' Test si les accolades fermantes de l'Infobox sont précédées d'un renvoi à la ligne
PosAccolade = InStr(TxtGeoloc1, "}")
If PosAccolade <> 0 Then
TxtGeoloc1 = Mid(TexteWP, k0, PosAccolade - 1)
End If
TxtGeoloc2 = Sheets("Code").Cells(68, 1) & " " & Sheets("Code").Cells(27, 4)
If PosAccolade <> 0 Then
TxtGeoloc2 = Sheets("Code").Cells(68, 1) & " " & Sheets("Code").Cells(27, 4) & Chr(10)
End If
TexteWP = Replace(TexteWP, TxtGeoloc1, TxtGeoloc2)
Else ' Cas où il n'y a pas de paramètre de géolocalisation
Sheets("Code").Cells(LigneGeoloc, 13) = Sheets("Code").Cells(6, 2)
Sheets("Code").Cells(LigneGeoloc, 14) = Sheets("Code").Cells(7, 2)
End If
' XXXXXXXXXXX Paramètres Légende et légende blason et légende drapeau
Txt1 = Chr(10) & "|légende"
Txt2 = Chr(10) & " | légende"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & "| légende"
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & " |légende"
TexteWP = Replace(TexteWP, Txt1, Txt2)
InfoboxLegende = 0 ' recherche présence éventuelle 1ère légende
For j = 1 To jfin
If Mid(TexteWP, j, 9) = "| légende" Then
InfoboxLegende = 1
k0 = j
j = jfin
End If
Next j
If InfoboxLegende = 1 Then
For j = k0 To jfin
If Mid(TexteWP, j, 1) = "=" Then
k1 = j + 1
j = jfin
End If
Next j
For j = k1 To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin1 = j
j = jfin
End If
Next j
TxtLegende1 = Mid(TexteWP, k0, kFin1 - k0)
TxtLegende1_Fin = Mid(TexteWP, k1, kFin1 - k1)
If Mid(TxtLegende1, 10, 2) = " b" Then
TxtLegende2 = Sheets("Code").Cells(48, 1) & TxtLegende1_Fin
TexteWP = Replace(TexteWP, TxtLegende1, TxtLegende2)
ElseIf Mid(TxtLegende1, 10, 2) = " d" Then
TxtLegende2 = Sheets("Code").Cells(76, 1) & TxtLegende1_Fin
TexteWP = Replace(TexteWP, TxtLegende1, TxtLegende2)
Else
TxtLegende2 = Sheets("Code").Cells(46, 1) & TxtLegende1_Fin
TexteWP = Replace(TexteWP, TxtLegende1, TxtLegende2)
End If
jfin = Len(TexteWP)
InfoboxLegende2 = 0
For j = k1 To jfin ' recherche présence éventuelle 2ème légende
If Mid(TexteWP, j, 9) = "| légende" Then
InfoboxLegende2 = 1
k2 = j
j = jfin
End If
Next j
If InfoboxLegende2 = 1 Then
For j = k2 To jfin
If Mid(TexteWP, j, 1) = "=" Then
k3 = j + 1
j = jfin
End If
Next j
For j = k3 To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin1b = j
j = jfin
End If
Next j
TxtLegende1b = Mid(TexteWP, k2, kFin1b - k2)
TxtLegende1b_Fin = Mid(TexteWP, k3, kFin1b - k3)
If Mid(TxtLegende1b, 10, 2) = " b" Then
TxtLegende2b = Sheets("Code").Cells(48, 1) & TxtLegende1b_Fin
TexteWP = Replace(TexteWP, TxtLegende1b, TxtLegende2b)
ElseIf Mid(TxtLegende1b, 10, 2) = " d" Then
TxtLegende2b = Sheets("Code").Cells(76, 1) & TxtLegende1b_Fin
TexteWP = Replace(TexteWP, TxtLegende1b, TxtLegende2b)
Else
TxtLegende2b = Sheets("Code").Cells(46, 1) & TxtLegende1b_Fin
TexteWP = Replace(TexteWP, TxtLegende1b, TxtLegende2b)
End If
End If
jfin = Len(TexteWP)
InfoboxLegende3 = 0
For j = k1 To jfin ' recherche présence éventuelle 3ème légende
If Mid(TexteWP, j, 9) = "| légende" Then
InfoboxLegende3 = 1
k4 = j
j = jfin
End If
Next j
If InfoboxLegende3 = 1 Then
For j = k4 To jfin
If Mid(TexteWP, j, 1) = "=" Then
k5 = j + 1
j = jfin
End If
Next j
For j = k5 To jfin
If Mid(TexteWP, j, 1) = Chr(10) Then
kFin1c = j
j = jfin
End If
Next j
TxtLegende1c = Mid(TexteWP, k4, kFin1c - k4)
TxtLegende1c_Fin = Mid(TexteWP, k5, kFin1c - k5)
If Mid(TxtLegende1c, 10, 2) = " b" Then
TxtLegende2c = Sheets("Code").Cells(48, 1) & TxtLegende1c_Fin
TexteWP = Replace(TexteWP, TxtLegende1c, TxtLegende2c)
ElseIf Mid(TxtLegende1b, 10, 2) = " d" Then
TxtLegende2c = Sheets("Code").Cells(76, 1) & TxtLegende1c_Fin
TexteWP = Replace(TexteWP, TxtLegende1c, TxtLegende2c)
Else
TxtLegende2c = Sheets("Code").Cells(46, 1) & TxtLegende1c_Fin
TexteWP = Replace(TexteWP, TxtLegende1c, TxtLegende2c)
End If
End If
End If
jfin = Len(TexteWP)
' XXXXXXXXXXX Autres paramètres
For k = 46 To 70
param = Sheets("Code").Cells(k, 4)
Txt1 = Chr(10) & "|" & param
Txt2 = Chr(10) & " | " & param
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & "| " & param
TexteWP = Replace(TexteWP, Txt1, Txt2)
Txt1 = Chr(10) & " |" & param
TexteWP = Replace(TexteWP, Txt1, Txt2)
InfoboxParam = 0
LonParam = Sheets("Code").Cells(k, 5) + 2
For j = 1 To jfin
If Mid(TexteWP, j, LonParam) = "| " & param Then
InfoboxParam = 1
k0 = j
j = jfin
End If
Next j
If InfoboxParam = 1 Then
For j = k0 To jfin
If Mid(TexteWP, j, 1) = "=" Then
kDeb = j + 1
j = jfin
End If
Next j
LigneParam2 = Sheets("Code").Cells(k, 6)
TxtParam1 = Mid(TexteWP, k0, kDeb - k0)
If Sheets("Code").Cells(LigneParam2, 1) = "" Then
TxtParam2 = Sheets("Code").Cells(LigneParam2, 1) & Chr(10)
Else
TxtParam2 = Sheets("Code").Cells(LigneParam2, 1)
End If
TexteWP = Replace(TexteWP, TxtParam1, TxtParam2)
End If
Next k
SuiteScriptA:
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXX CHARGEMENT CODE SUR ARTICLE XXXXXXXXXXXXXXXXXXXXXXXXXXXX
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Wait2 (3)
'CHARGEMENT SUR WP XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' IE.Navigate "https://fr.wikipedia.org/w/index.php?title=Utilisateur:Roland45/test1&action=edit"
IE.Navigate "https://fr.wikipedia.org/w/index.php?title=" & NomCodeCommune & "&action=edit"
IE.Visible = False
WaitIE IE
Set IEDoc = IE.Document
Set InputWPZoneTexte = IEDoc.all("wpTextbox1")
Set InputWPResume = IEDoc.all("wpSummary")
InputWPZoneTexte.Value = TexteWP
TxtResume = "Actualisation Infobox"
InputWPResume.Value = TxtResume
Set InputWPSave = IE.Document.getElementsByTagName("input")
Set WpSave = InputWPSave.Item("wpSave")
WpSave.Value = "Publier les modifications"
Dim Connect As Object
Set InputWp = IEDoc.all("wpSave")
InputWp.Click
WaitIE IE
Wait2 (3)
' End If
FinCode:
Next i
'
End Sub
Sub WaitIE(IE As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargée
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
End Sub
Sub Wait2(length)
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + length
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
End Sub
