Office: (Office 2010) HTML Text in excel in formatierten Text umwandeln pro Zelle

Komtur77 · 3. Oktober 2016

Hallo zusammen.

Wie im Betreff beschrieben, muss ich HTML in Text umwandeln und dabei die Formatierung übernehmen. Die Daten habe ich bereits über das MS Managementstudio / SQL Server 2008 R2 von der XML-Datei ausgelesen und in eine Excel kopiert. Darin ist nun im Register "Tabelle1" eine Spalte (A) mit der Teilenummer und Spalte (B) die Teilebeschreibung.

In Spalte B befindet sich somit ein langer String, welche neben dem eigentlichen Text auch HTML-Tags enthält, sowie Aufzählungspunkte.

Über Tante Google bin ich auf folgenden Code gestoßen:

Code:

' Projekt: Inhalt einer Excel-Zelle mit HTML-Text in reinen Text, wobei Zeilenumbruch
' innerhalb der Zelle stattfinden soll (und nicht in eine neuen Zelle führen soll)
'
' Version: 01 - 26.05.2014

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.EnableEvents = False
HTML_Umwandeln Target ' Umwandlung 'HTML -> Text' vornehmen
Application.EnableEvents = True

End Sub

' *****************************************************************************
' HINWEIS: Verweis einfügen auf 'Microsoft Forms 2.0 Object Library'
' ggf. mittels durchsuchen von '' nach 'FM20.DLL'
' *****************************************************************************

Sub HTML_Umwandeln(ByVal Target As Range)

Const VBLF_MARKER As String = "[[\n]]"
Const FETT_MARKER As String = "~~~~"
Const LEERER_STRING = ""

Dim objData As MSForms.DataObject
Dim sHTML As String
Dim sSelAdd As String

On Error GoTo FehlerMeldung

If Target.Cells.Count = 1 Then ' Nur wenn genau 1 Zelle markiert ist
If LCase(Left(Target.Text, 6)) = "" Then
Set objData = New MSForms.DataObject

sHTML = Target.Text ' HTML-Text in der makierten Excel-Zelle

'sHTML = Replace(sHTML, "", "br{mso-data-placement:same-cell;}")

sHTML = Replace(sHTML, "", FETT_MARKER)
sHTML = Replace(sHTML, "", FETT_MARKER)

sHTML = Replace(sHTML, "", VBLF_MARKER)
sHTML = Replace(sHTML, "

", VBLF_MARKER)

sHTML = Replace(sHTML, "

", LEERER_STRING)
sHTML = Replace(sHTML, "

", LEERER_STRING)

sHTML = Replace(sHTML, "
[*]", LEERER_STRING)
sHTML = Replace(sHTML, "", VBLF_MARKER)

objData.SetText sHTML ' Fügt dem Datenobjekt den Text im UnicodeText-Format hinzu
objData.PutInClipboard ' In die Zwischenablage überführen

sSelAdd = Selection.Address ' Adresse der markierten Zelle
Target.Select ' Selektieren der Zelle

'Me.PasteSpecial ' "Unicode Text" aus der Zwischenablage
Me.PasteSpecial Format:="Unicode-Text" ' Aus der Zwischenablage einfügen
'Me.Range(sSelAdd).Select

Selection.Value = Replace(Selection.Value, VBLF_MARKER, vbLf) ' Marker ersetzen durch vbLf
Selection.WrapText = True ' Textumbruch in der Zelle zulassen
ActiveCell.VerticalAlignment = xlVAlignTop

' *************************************************************
' *** RegEx um bestimmte Teile des Textes fett zu markieren ***
' *************************************************************
Dim objRegEx As Object, objMatches As Object, objMatch As Object
Dim strText As String
Dim intIndex As Integer

Dim MatchStart As Long
Dim MatchLänge As Long
Dim MarkerLänge As Long

Set objRegEx = CreateObject("VbScript.RegExp")

With objRegEx
.Global = True
.IgnoreCase = True ' Egal ob Groß-/Kleinschreibung
.MultiLine = False ' Alles als 1 Zeile auffassen
.Pattern = FETT_MARKER & ".+" & FETT_MARKER ' Erkenungsmuster (beliebige Zeichen zwischen den beiden Markern)

Set objMatches = .Execute(Selection.Value) ' Suche ausführen
End With

MarkerLänge = Len(FETT_MARKER)

For Each objMatch In objMatches ' Alle Treffer in der Trefferliste durchlaufen
MatchStart = objMatch.FirstIndex + MarkerLänge ' Beginn des Treffers (ohne Marker am Anfang)
MatchLänge = objMatch.Length - (2 * MarkerLänge) ' Länge des Treffers (ohne die beiden Marker)
' Debug.Print objMatch
' Debug.Print MatchStart
' Debug.Print MatchLänge

Selection.Characters(MatchStart, MatchLänge).Font.Bold = True ' Rest des Terffer 'fett'
Next

Set objRegEx = Nothing
Set objMatches = Nothing

End If
End If

Exit Sub

FehlerMeldung:
MsgBox "Fehler: " & Err.Description

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Soweit so klar. Der Code passt nach der Problembeschreibung auf meines.

Natürlich werde ich den Code noch entsprechend anpassen müssen...

Nun bin ich leider nicht sehr mit Excel vertraut. Deshalb meine Frage:

Wie erstelle ich hier ein Makro? Muss ich das auf meine Spalte B beziehen? Wenn ja wie? Wie spreche ich das Makro an? Hier wird es doch über einen Doppelklick angesprochen, richtig?

Meine Ausgangslage ist wie oben beschrieben, eine Excel. In Tabelle1 sind zwei Spalten. A = Teil und B = Beschreibung. In diese Excel möchte ich nun diesen Code einbauen, testen und auf meine Bedürfnisse anpassen.

Wie mache ich das?

Vielen Dank.

Gruß
Komtur77

:)

Office: (Office 2010) HTML Text in excel in formatierten Text umwandeln pro Zelle

HTML Text in excel in formatierten Text umwandeln pro Zelle

HTML Text in excel in formatierten Text umwandeln pro Zelle

HTML Text in excel in formatierten Text umwandeln pro Zelle - Similar Threads - HTML Text excel

Textformatierung konvertieren in Text mit HTML-Markups

Ändern des Nachrichtenformats in "Nur-Text", "HTML" oder "Rich-Text-Format"

Rich-Text-Memofeld als HTML-String ausgeben.

HTML Text in xls aufspalten

automatische Formatierung bei Antworten in Outlook 2016

Outlook 2016 // Datei einfügen // Als Text einfügen wird nicht als Option angezeigt

HTML (Text) aus Pfad in Zelle importieren (html-formatiert oder unformatiert)