makro yazı renk ve boyut kodu yardım!

[x53x53x]

başka bir konuda bu konuda yardım istedim ama yanıt alamadım o yüazden yeni konu açıyorum.

Aşşağıdaki makroyu uyguladığımda tırnak içerisindeki yazı 1 ve yazı 2nin rengini ve boyutunu nasıl değiştirebilirim?

Sub Yerine_Koy()
Dim r As Range, rg As Range

Set rg = Range("A1:A30")

For Each r In rg
r = "YAZI 1 " & r & " YAZI 2 "
Next

Set rg = Nothing

End Sub

 

[excel03]

Merhaba;

Sub Yerine_Koy()
Dim r As Range, rg As Range
Set rg = Range("A1:A30")

For Each r In rg

r = "YAZI 1 " & r & " YAZI 2 "
With r.Characters(1, 7).Font
.Color = vbRed
.Size = 12
End With

With r.Characters(Len(r) - 7, 8).Font
.Color = vbRed
.Size = 12
End With

Next

Set rg = Nothing

End Sub

 

[x53x53x]

Öncelikle yanıtınız için çok teşekkürler

düzenlediğiniz makroyu sadece yazı boyutunu değiştirdim normalde 12 iken 16 yaptım fakat sadece yazı1 için geçerli oldu bu yazı2 yine 12 fontta kaldı, resimde gönderiyorum bide ek olarak bold yani kalın yapabilirmiyiz yazı1 ve yazı2yi?

 

[excel03]

merhaba;

Sub Yerine_Koy()
Dim r As Range, rg As Range
Set rg = Range("A1:A30")

For Each r In rg

r = "YAZI 1 " & r & " YAZI 2 "
'*************YAZI 1 İÇİN *******************
With r.Characters(1, 7).Font
.Color = vbBlue
.Size = 10
.Bold = True
End With
'********************************************
'
' *********YAZI 2 İÇİN **********************
With r.Characters(Len(r) - 7, 8).Font
.Color = vbBlue
.Size = 10
.Bold = True
End With
'********************************************
Next

Set rg = Nothing

End Sub

 

[x53x53x]

tekrardan cevaplarınız için çok teşekkür ederim, son olarak yazı1 bir ve yazı2 ye link verme şansımız varmı?

 

[excel03]

link vermek (Excelde Köprü Ekleme)

bir hücreye bir tek link verilebilir diye biliyorum.Bir hücre içinde bulunan metnin bir kısmına bir köprü,diğer başka bir kısmına bir başka köprü yapılabileceği hususunda bir fikrim yok.

 

[x53x53x]

peki sadece yazı2 ye link vermek mümkünmüdür?

 

[excel03]

'İşinize yaraması temennisiyle
Sub Yerine_Koy()
Dim r As Range, rg As Range
Set rg = Range("A1:A30")

For Each r In rg

r = "YAZI 1 " & r & " YAZI 2 "
'*************YAZI 1 İÇİN *******************
With r.Characters(1, 7).Font
.Color = vbBlue
.Size = 10
.Bold = True
End With
'********************************************
'
' *********YAZI 2 İÇİN **********************
With r.Characters(Len(r) - 7, 8).Font
.Color = vbBlue
.Size = 10
.Bold = True
End With
'********************************************
r.Hyperlinks.Add r, "D:\Belgelerim" '<<buraya kendi _
bilgisayarınızdaki dosya yolunun tam adını yazınız.

Next


Set rg = Nothing

End Sub

 

[x53x53x]

işime yaradı hemde çok, ellerinize sağlık çok teşekkürler

 

[x53x53x]

tekrar merhaba konu hakkında size bir soru sormam gerekiyor

makroda Set rg = Range("A1:A30") şeklinde a1 ile a30 arasındaki bütün hücrelere normalde uygulayabiliyoruz şuan ihtiyacım olan şey a1 a8 a20 a23 gibi bellibir aralıktaki tüm hücrelere değilde kendim belirleyeceğim hücrelere ekleme yapmak istiyorum bunu nasıl gerçekleştirebilirim?

 

[excel03]

merhaba;
anladığım kadarıyla şöyle birşey.

Sub Yerine_Koy()
On Local Error GoTo 10
Dim r As Range, rg As Range
Dim xRange
xRange = InputBox("İşlem yapılacak aralığı giriniz.", _
"Aralık Tespiti", "A1:A30")
Set rg = Range(xRange)

For Each r In rg

r = "YAZI 1 " & r & " YAZI 2 "
'*************YAZI 1 İÇİN *******************
With r.Characters(1, 7).Font
.Color = vbBlue
.Size = 10
.Bold = True
End With
'********************************************
'
' *********YAZI 2 İÇİN **********************
With r.Characters(Len(r) - 7, 8).Font
.Color = vbBlue
.Size = 10
.Bold = True
End With
'********************************************
r.Hyperlinks.Add r, "D:\Belgelerim" '<<buraya kendi _
bilgisayarınızdaki dosya yolunun tam adını yazınız.

Next


Set rg = Nothing
10:
End Sub

 

[x53x53x]

teşekkür ederim harikasınız