aynı hücrede alt alta birleştirmek(ayrı Fontlarda)

[memetcirak]

a2 ve b2 yi birleiştirmek istiyorum fakat alt satır barkod fontunda üst satır yazı fontunda olması gerekli böyle bir şey mümkünmüdür.

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub Birlestir()
    
    
    Dim i   As Long
    Dim Bas As Integer
    Dim Uz  As Integer
    
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
    
        Cells(i, "C") = Cells(i, "A") & Chr(10) & Cells(i, "B")
        Uz = Len(Cells(i, "B"))
        Bas = Len(Cells(i, "C")) - Uz + 1
        
        With Range("C" & i).Characters(Start:=Bas, Length:=Uz).Font
            .Name = "C39HrP60DlTt"
            .FontStyle = "Normal"
            .Size = 40
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Birleştirildi..."
    
End Sub

 

[memetcirak]

Merhaba
Çok teşekkürler çalışıyor

 

[memetcirak]

Sub ekle_60()

Dim i As Long
Dim Bas As Integer
Dim Uz As Integer

Application.ScreenUpdating = False

For i = 2 To Cells(Rows.Count, "A").End(3).Row

Cells(i, "C") = Cells(i, "A") & Chr(10) & "*" & Cells(i, "B") & "*"
Uz = Len(Cells(i, "B"))
Bas = Len(Cells(i, "C")) - Uz + 1

With Range("C" & i).Characters(Start:=Bas, Length:=Uz).Font
.Name = "C39HrP60DlTt"
.FontStyle = "Normal"
.Size = 40
End With

Next i



End Sub



merhaba boyalı kodları ekledğimde barkod olan fontların başındaki * işareti biraz kayıyor yanlışmı ekliyorum.. barkodların başına "*" eklemem gerekli yoksa lazer görmüyor barkodları

 

[Necdet]

Merhaba,

Aşağıdaki gibi kullanınız.

Sub Birlestir()
    
    Dim i   As Long
    Dim Bas As Integer
    Dim Uz  As Integer
    
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
    
        Cells(i, "C") = Cells(i, "A") & Chr(10) [COLOR=red][B]& "*"[/B][/COLOR] & Cells(i, "B") [B][COLOR=red]& "*"
[/COLOR][/B]        Uz = Len(Cells(i, "B")) [B][COLOR=red]+ 2
[/COLOR][/B]        Bas = Len(Cells(i, "C")) - Uz + 1
        
        With Range("C" & i).Characters(Start:=Bas, Length:=Uz).Font
            .Name = "C39HrP60DlTt"
            .FontStyle = "Normal"
            .Size = 40
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Birleştirildi..."
    
End Sub

 

[memetcirak]

çok teşekkür ederim tekrar.

 

[Necdet]

Güle güle kullanınız.