hi all !

I want to contenate bold and standard text into one cell. i already
have a macro doing the job:

Sub Neuesding1()
ActiveCell.FormulaR1C1 = "=CONCATENATE(R2C1,R2C2)"
ActiveCell = ActiveCell.Value
With ActiveCell.Characters(Start:=1, Length:=4).Font
..FontStyle = "standard"
End With
With ActiveCell.Characters(Start:=5, Length:=4).Font
..FontStyle = "bold"
End With
End Sub

but i actually need a function and i dont know how to re-formulate the
macro above to make it a function

on the web i found a funtion doing the job, but i can not call it
directly (#VALUE!), only via another macro. here it is all together:

Sub Tester91()
BldString Range("A4"), Range("A1:A2"), Range("B1")
End Sub
----------------------------------------------------
Function BldString(destCell As Range, ParamArray rng() As Variant)
Dim cChr As Characters
Dim i As Long, l As Long, k As Long
Dim m As Long
Dim sStr As String
Dim cell As Range
sStr = ""
For i = LBound(rng) To UBound(rng)
If TypeName(rng(i)) = "Range" Then
For Each cell In rng(i)
sStr = sStr & cell.Value & " "
Next
End If
Next
destCell.Value = sStr
k = 0
For i = LBound(rng) To UBound(rng)
If TypeName(rng(i)) = "Range" Then
For Each cell In rng(i)
m = Len(cell.Value) + 1
If Application.IsText(cell) Then
For l = 1 To m
k = k + 1
If l < m Then
Set cChr = cell.Characters(l, 1)
With destCell.Characters(k, 1)
..Font.Name = cChr.Font.Name
..Font.FontStyle = cChr.Font.FontStyle
..Font.ColorIndex = cChr.Font.ColorIndex
..Font.Size = cChr.Font.Size
..Font.Underline = cChr.Font.Underline
End With
End If
Next
ElseIf Application.IsNumber(cell) Then
k = k + 1
With destCell.Characters(k, m)
..Font.Name = cell.Font.Name
..Font.FontStyle = cell.Font.FontStyle
..Font.ColorIndex = cell.Font.ColorIndex
..Font.Size = cell.Font.Size
..Font.Underline = cell.Font.Underline
End With
k = k + m - 1
End If
Next
End If
Next
End Function

thxalot


--
Leitwolf25
------------------------------------------------------------------------
Leitwolf25's Profile: http://www.excelforum.com/member.php...o&userid=34323
View this thread: http://www.excelforum.com/showthread...hreadid=540897

A function cannot change attributes of a worksheet, it can only return a
value, so you can't do what you want.

--
HTH

Bob Phillips

(remove xxx from email address if mailing direct)

"Leitwolf25" wrote
in message ...

hi all !

I want to contenate bold and standard text into one cell. i already
have a macro doing the job:

Sub Neuesding1()
ActiveCell.FormulaR1C1 = "=CONCATENATE(R2C1,R2C2)"
ActiveCell = ActiveCell.Value
With ActiveCell.Characters(Start:=1, Length:=4).Font
FontStyle = "standard"
End With
With ActiveCell.Characters(Start:=5, Length:=4).Font
FontStyle = "bold"
End With
End Sub

but i actually need a function and i dont know how to re-formulate the
macro above to make it a function

on the web i found a funtion doing the job, but i can not call it
directly (#VALUE!), only via another macro. here it is all together:

Sub Tester91()
BldString Range("A4"), Range("A1:A2"), Range("B1")
End Sub
----------------------------------------------------
Function BldString(destCell As Range, ParamArray rng() As Variant)
Dim cChr As Characters
Dim i As Long, l As Long, k As Long
Dim m As Long
Dim sStr As String
Dim cell As Range
sStr = ""
For i = LBound(rng) To UBound(rng)
If TypeName(rng(i)) = "Range" Then
For Each cell In rng(i)
sStr = sStr & cell.Value & " "
Next
End If
Next
destCell.Value = sStr
k = 0
For i = LBound(rng) To UBound(rng)
If TypeName(rng(i)) = "Range" Then
For Each cell In rng(i)
m = Len(cell.Value) + 1
If Application.IsText(cell) Then
For l = 1 To m
k = k + 1
If l < m Then
Set cChr = cell.Characters(l, 1)
With destCell.Characters(k, 1)
Font.Name = cChr.Font.Name
Font.FontStyle = cChr.Font.FontStyle
Font.ColorIndex = cChr.Font.ColorIndex
Font.Size = cChr.Font.Size
Font.Underline = cChr.Font.Underline
End With
End If
Next
ElseIf Application.IsNumber(cell) Then
k = k + 1
With destCell.Characters(k, m)
Font.Name = cell.Font.Name
Font.FontStyle = cell.Font.FontStyle
Font.ColorIndex = cell.Font.ColorIndex
Font.Size = cell.Font.Size
Font.Underline = cell.Font.Underline
End With
k = k + m - 1
End If
Next
End If
Next
End Function

thxalot


--
Leitwolf25
------------------------------------------------------------------------
Leitwolf25's Profile:
http://www.excelforum.com/member.php...o&userid=34323
View this thread: http://www.excelforum.com/showthread...hreadid=540897