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

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
100
Excel Vers. ve Dili
2007
Örnektede açıkladığım gibi, formülle çektiğim hücre içini düzenlemek istiyorum mümkünmü?
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
100
Excel Vers. ve Dili
2007
Örnekte anlattığım gibi olsa yeterli ben mantığını kavrayıp kendi çalışmamam uyarlardım.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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:

Kod:
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
 
Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Alternatif olarak. I4 hücresinde deneyiniz
Kod:
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
 
Son düzenleme:

yasarcan

Altın Üye
Katılım
30 Nisan 2016
Mesajlar
100
Excel Vers. ve Dili
2007
Teşekkür ederim
ikiside İşimi fazlasıyla gördü
 
Üst