Robert87
12-19-2013, 02:28 AM
Hello!
I´m using this vba code to change font on certain letters in certain cells.
Option Explicit
Option Compare Binary
Sub WingDingsFtoM1()
Dim c As Range, r As Range
Dim v As Variant, a() As String, i As Integer
Set r = Range("F3,AA3,F15,AA15,F27,AA27,F39,AA39,F51,AA51,F63,AA63,F75,AA75,F87,AA87,F99,A A99,F111,AA111,F123,AA123,F135,AA135,F147,AA147,F159,AA159,F171,A171,F183,A A183,F195,AA195,F207,AA207,F219,AA219,F231,AA231,F243,AA243,F255,AA255,F267 ,AA267,F279,AA279,F291,AA291")
a() = Split("f g h i j k l m", " ")
For Each c In r
With c
If IsEmpty(c) Then GoTo NextC
For i = 1 To Len(.Value2)
For Each v In a()
If .Characters(i, Len(.Value2)).Font.Name <> "Wingdings 3" And _
Mid(.Value2, i, 1) = v Then _
.Characters(i, 1).Font.Name = "Wingdings 3"
Next v
Next i
NextC:
End With
Next c
End Sub
Now I need to add a function to that script.
I need it to replace the word "streck" with an image of my choice, in the same cells.
Could anyone help me with this?
I´m using this vba code to change font on certain letters in certain cells.
Option Explicit
Option Compare Binary
Sub WingDingsFtoM1()
Dim c As Range, r As Range
Dim v As Variant, a() As String, i As Integer
Set r = Range("F3,AA3,F15,AA15,F27,AA27,F39,AA39,F51,AA51,F63,AA63,F75,AA75,F87,AA87,F99,A A99,F111,AA111,F123,AA123,F135,AA135,F147,AA147,F159,AA159,F171,A171,F183,A A183,F195,AA195,F207,AA207,F219,AA219,F231,AA231,F243,AA243,F255,AA255,F267 ,AA267,F279,AA279,F291,AA291")
a() = Split("f g h i j k l m", " ")
For Each c In r
With c
If IsEmpty(c) Then GoTo NextC
For i = 1 To Len(.Value2)
For Each v In a()
If .Characters(i, Len(.Value2)).Font.Name <> "Wingdings 3" And _
Mid(.Value2, i, 1) = v Then _
.Characters(i, 1).Font.Name = "Wingdings 3"
Next v
Next i
NextC:
End With
Next c
End Sub
Now I need to add a function to that script.
I need it to replace the word "streck" with an image of my choice, in the same cells.
Could anyone help me with this?