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
-
9.6 KB Görüntüleme: 15
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
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
Rica ederim.Dönüş yaptığınız için teşekkür ederim.Teşekkür ederim
ikiside İşimi fazlasıyla gördü