Bonjour,
J'ai réalisé (merci JNP) une macro permettant d'enlever correctement le code HTML d'une plage de données.
Je parcours un tableau html regroupant les eventuels bout de code à enlever et je boucle sur ce tableau.
Pour l'optimiser, je souhaiterais vérifier que les cellules du tableau que je vais parcourir existent bien dans le code html.
Voila ce que j'ai fait :
1) Je copie le tableau HTML où je vais supprimer les lignes qui existent dans le code avant de le parcourir.
2) Je renomme le tableau. (ERREUR)
3) Je lance un find pour chaque cellule du tableau, la selection étant une colonne de code HTML présente dans le deuxieme onglet
4) Je lance la macro pour retirer le code HTML
La macro est la suivante :
Pour information, la ligne posant erreur fonctionne correctement lorsquelle est placée dans une macro sur la feuille "HTML"
Et la pièce jointe ,
Avez vous une solution ?
Cdt,
Arthur HO.
J'ai réalisé (merci JNP) une macro permettant d'enlever correctement le code HTML d'une plage de données.
Je parcours un tableau html regroupant les eventuels bout de code à enlever et je boucle sur ce tableau.
Pour l'optimiser, je souhaiterais vérifier que les cellules du tableau que je vais parcourir existent bien dans le code html.
Voila ce que j'ai fait :
1) Je copie le tableau HTML où je vais supprimer les lignes qui existent dans le code avant de le parcourir.
2) Je renomme le tableau. (ERREUR)
3) Je lance un find pour chaque cellule du tableau, la selection étant une colonne de code HTML présente dans le deuxieme onglet
4) Je lance la macro pour retirer le code HTML
La macro est la suivante :
Code:
Sub FindHTMLCode2() 'SelectedRange As Range)
Dim rFound As Range, cell As Range
Dim I As Long
I = 3
Sheets("HTML").Select
Range("A2:D41").Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
ActiveSheet.ListObjects(ListObjects.Count).Name = "UsedHTMLTable" ========> ERREUR ICI 'Objet Requis'
Sheets(2).Select
Range(Cells(1, 7), Cells(97, 7)).Select
With Selection
Application.DisplayAlerts = False
For I = 3 To Range("UsedHTMLTable[HTML]").Rows.Count
Set rFound = .Find(What:="cells(I,7).value", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFound Is Nothing Then Range(Cells(I, 7), Cells(I, 9)).Delete
Next I
Application.DisplayAlerts = True
On Error GoTo 0
End With
End Sub
Function removeHTMLTags(onglet)
Dim Cellule As Range, I As Integer, MaString As String
Dim lastrow As Long
'Sheets("HTML").Calculate
Application.StatusBar = "Removing HTML Tags.."
lastrow = Sheets(onglet).[A65536].End(xlUp).Row
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\<(?!(?:br)).*?\>"
For Each Cellule In Selection
MaString = Cellule.Value
If MaString = "" And Cellule.Row > lastrow Then
Exit For
Else
'MaString = Replace(MaString, "<br>", Chr(10))
MaString = .Replace(MaString, " ")
MaString = Replace(MaString, "<br>", Chr(10))
For I = 1 To Range("Tableau1[HTML]").Rows.Count
MaString = Replace(MaString, Range("Tableau1[HTML]")(I).Value, Chr(Range("Tableau1[ASCII]")(I).Value))
Next I
End If
Cellule.Value = MaString
Next Cellule
End With
End Function
Pour information, la ligne posant erreur fonctionne correctement lorsquelle est placée dans une macro sur la feuille "HTML"
Et la pièce jointe ,
Avez vous une solution ?
Cdt,
Arthur HO.
Pièces jointes
Dernière édition: