Çözüldü Hücre içine farklı font ve boyut atama

[yasarcan]

Örnektede açıkladığım gibi, formülle çektiğim hücre içini düzenlemek istiyorum mümkünmü?

 

[YUSUF44]

Formülle olacağını sanmıyorum. Makroyla olabilir ancak bunun için de alınan verinin hangi kısmının ne biçimde olacağının belli olması lazım.

 

[yasarcan]

Örnekte anlattığım gibi olsa yeterli ben mantığını kavrayıp kendi çalışmamam uyarlardım.

 

[YUSUF44]

Aşağıdaki kodu deneyiniz. Örnekte iki kelime ve bir boşluk olduğu için biçimlendirmeyi boşluktan önce ve boşluktan sonra şeklinde ayarladım. Formüllü hücrede farklı biçimler olmayacağı için de önce I4'e B4'teki veriyi yazdırdım:

Sub düzenle()
    [I4] = [B4]
    boşluk = WorksheetFunction.Find(" ", [I4])
    With [I4].Characters(Start:=1, Length:=boşluk - 1).Font
        .Name = "Calibri"
        .FontStyle = "Kalın"
        .Size = 26
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With [I4].Characters(Start:=boşluk, Length:=Len([I4]) - boşluk + 1).Font
        .Name = "CityBlueprint"
        .FontStyle = "Kalın İtalik"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = vbRed
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
End Sub

 

[çıtır]

Alternatif olarak. I4 hücresinde deneyiniz

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Byte
    Dim Renk As Byte
     If Intersect(Target, Range("I4")) Is Nothing Then Exit Sub
    Target.Font.Bold = True: Target.Font.Size = 26: Target.Font.Name = "Calibri"
    t = Len(Target.Value) - Len(WorksheetFunction.Substitute(Target.Value, " ", ""))
    If t > 0 Then
    Bul = WorksheetFunction.Find(" ", Target.Text)
    Renk = Len(Target.Text) - Bul + 1
    Target.Characters(Start:=Bul, Length:=Renk).Font.ColorIndex = 3
    Target.Characters(Start:=Bul, Length:=Renk).Font.Name = "SWGothe"
    Target.Characters(Start:=Bul, Length:=Renk).Font.Size = 12
    Target.Characters(Start:=Bul, Length:=Renk).Font.Italic = True
   End If
End Sub

 

[yasarcan]

Teşekkür ederim
ikiside İşimi fazlasıyla gördü

 

[çıtır]

Teşekkür ederim
ikiside İşimi fazlasıyla gördü

Rica ederim.Dönüş yaptığınız için teşekkür ederim.