Euroteken in kolom plaatsen

Hallo, ik heb een dataveld (tab gescheiden) wat ik in een word document via VBA converteer naar een tabel. De tabel bevat dan 5 kolommen. in de eerste rij staan de kopjes. In de rij(en) eronder staan de gegevens. Ik schrijf rij(en) omdat dit er 1 of meerdere kunnen zijn. Nu voeg ik na kolom 2 en 3 een kolom in. Wat ik nu zou willen is dat in die toegevoegde kolom op alle rijen die gevuld zijn een euroteken wordt ingevuld. Zie voorbeeld. In dit voorbeeld is maar 1 rij gevuld. Dat kunnen er dus meerdere zijn. Wie helpt me op weg?

Jos

Gebruik je ook andere valuta ?

Nee, alleen euries.

Doe er eens een voorbeeldje bij, dat scheelt ons weer tijd. Met uiteraard de macro's.

Het meest eenvoudige lijkt mij :
Gebruik in plaats van Word Excel.
Via cel-eigenschappen kun je het €-teken in de cel zetten.
Als je het in Word wil hebben kun je het kopiëren en plakken.

OctaFish zei:

Doe er eens een voorbeeldje bij, dat scheelt ons weer tijd. Met uiteraard de macro's.

Klik om te vergroten...

Dit is wat ik tot zover heb.

Selection.HomeKey wdStory
ActiveWindow.View.ShowFieldCodes = False
ActiveDocument.Bookmarks("Bm_1").Range.Fields(1).Unlink
Selection.GoTo What:=wdGoToBookmark, Name:="Bm_1"
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=5, _
NumRows:=3, AutoFitBehavior:=wdAutoFitContent
'hier voeg ik de eerste kolom toe
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.InsertColumnsRight

'Hier voeg ik de 2e kolom toe
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.InsertColumnsRight

'Hier gaat het fout en is dus mijn vraag
For i = Selection.Tables(1).Rows.Count To 1 Step -1
If Len(Selection.Tables(1).Cell(i, 2).Range.Text) <= 2 Then
Selection.TypeText Text:="€"
End If
Next i


With Selection.Tables(1)
.Style = "Tabelraster"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.Columns(1).Width = CentimetersToPoints(3)
.Columns(2).Width = CentimetersToPoints(3)
.Columns(3).Width = CentimetersToPoints(0.6)
.Columns(4).Width = CentimetersToPoints(3)
.Columns(5).Width = CentimetersToPoints(0.6)
.Columns(6).Width = CentimetersToPoints(3)

End With

'Hier laat ik de lege rijen verwijderen
For i = Selection.Tables(1).Rows.Count To 1 Step -1
If Len(Selection.Tables(1).Cell(i, 4).Range.Text) <= 2 Then
Selection.Tables(1).Rows(i).Delete
End If
Next i

Sjoef zei:

Dit is wat ik tot zover heb.

Klik om te vergroten...

Je zou na 9 jaar HelpMij toch moeten weten dat je code ALTIJD in de CODE tags moet zetten .

sorry, ik was wat gehaast......

Ik zie ook geen voorbeeldbestand.

voorbeeld bestand kan ik helaas niet leveren ivm privecy gevoelige gegevens. Sorry. Vandaar dat ik een "fake" tabelletje gepost heb.

Gedraag je als een voorbeeldig forumlid en lees dit eens: http://www.helpmij.nl/forum/announcement.php?f=348