Çözüldü Yazının sonundan sonra hep aynı mesafede imza hanesinin açılması

By.TRabZonLutm · 23 Mayıs 2024

Merhaba arkadaşlar, excelde son satırın bittiği yerde. Hep aynı mesafede nasıl imza blogu açabilirim

necati · 23 Mayıs 2024

Merhaba,
İmza bloğunu "resim" olarak mı "metin kutusu" olarak mı ekliyorsunuz?

By.TRabZonLutm · 23 Mayıs 2024

necati' Alıntı:
Merhaba,
İmza bloğunu "resim" olarak mı "metin kutusu" olarak mı ekliyorsunuz?

Hocam metin olmadan direkt hücreye de olabilir, metin de olabilir.
Üstte yazılan açıklama uzun olursa imza hanesi açıklamaya çok yakın oluyor tekrar tekrar uğraşmak gerekiyor. Ya da açıklama kısa oluyor imza hanesi çok uzakta kalıyor

necati · 23 Mayıs 2024

Örneklere göre ayarlayabilirsiniz. Stok isimli sayfada çalışan makro:
' If Resim.Name = "1 Resim" Then
' If Resim.Name = "1 Metin kutusu" Then
' If Resim.Name = "Picture 1" Then

Kod:

Sub imza()
For Each Resim In Sheets("Stok").Shapes
    If Resim.Name = "Picture 1" Then
        Resim.Copy
        ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
        Resim.Delete
    End If
Next
End Sub

By.TRabZonLutm · 23 Mayıs 2024

H

necati' Alıntı:
Örneklere göre ayarlayabilirsiniz. Stok isimli sayfada çalışan makro:
' If Resim.Name = "1 Resim" Then
' If Resim.Name = "1 Metin kutusu" Then
' If Resim.Name = "Picture 1" Then

Kod:

Sub imza() For Each Resim In Sheets("Stok").Shapes If Resim.Name = "Picture 1" Then Resim.Copy ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7) Resim.Delete End If Next End Sub

Hocam Stok isimli, bir kaç cümle yazdığıma sayfada denedim ama birşey olmadı. Nerede hata yaptım

necati · 23 Mayıs 2024

İmzanızı bir resim olarak veya bir metin kutusu olarak sayfada bir yerde bulundurun. Nesne ismini verdiğim örneklere göre kendiniz düzenleyin. Sonra makroyu çalıştırın. Ne kadar satır olursa olsun imza bloku sağ alt köşede belirlediğiniz uzaklıkta yerini alır.

By.TRabZonLutm · 23 Mayıs 2024

necati' Alıntı:
İmzanızı bir resim olarak veya bir metin kutusu olarak sayfada bir yerde bulundurun. Nesne ismini verdiğim örneklere göre kendiniz düzenleyin. Sonra makroyu çalıştırın. Ne kadar satır olursa olsun imza bloku sağ alt köşede belirlediğiniz uzaklıkta yerini alır.

Metin kutusu oluşturdum makro çalışırdım ama bir değişiklik olmadı hocam. Aynı yerde duruyor

necati · 23 Mayıs 2024

Paylaşım sitesine örnek yükleyebilir misiniz?

By.TRabZonLutm · 23 Mayıs 2024

necati' Alıntı:
Paylaşım sitesine örnek yükleyebilir misiniz?

Maalesef korumalı hocam yukleyemiyorum.
Test adında makro kitaplık oluşturdum, Stok adında sayfa,
Görseldeki kodu belirtilen yere yazdım
Boş bir yere , ekle menüsünden metin kutusu ekledim
Geliştirici seçeneklerinden makro çalıştırdim fakat aynı yerde duruyor metin kutusu

necati · 23 Mayıs 2024

Ben bir örnek hazırladım.
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
Yazıların 10 satır altına 7. sütun hizasında imza bloku.
Örnek linki

By.TRabZonLutm · 23 Mayıs 2024

necati' Alıntı:
Ben bir örnek hazırladım.
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
Yazıların 10 satır altına 7. sütun hizasında imza bloku.
Örnek linki

Hocam örneği inceledim. Ama yine çalışmadı. Sizin yaptığınız tam olarak ne yapıyor.

necati · 23 Mayıs 2024

Metin kutusu olarak sayfada herhangi bir yerde bulunan imza kutusunu istediğimiz standart bir koordinata getiriyor.

By.TRabZonLutm · 23 Mayıs 2024

necati' Alıntı:
Metin kutusu olarak sayfada herhangi bir yerde bulunan imza kutusunu istediğimiz standart bir koordinata getiriyor.

Valla çalışmıyor bende yerini değiştiriyorum makro çalıştırıyorum değiştirdiğim yerde kalıyor 10satin 7. Sütun olayı olmuyor

necati · 23 Mayıs 2024

On error resume "örnek dosya"

By.TRabZonLutm · 23 Mayıs 2024

necati' Alıntı:
On error resume "örnek dosya"

Hocam sizin dosya üzerinde yapıyorum

23 Mayıs 2024

youtube.com

necati · 23 Mayıs 2024

Uzaktan ancak bu kadar. Forum arkadaşlarından yardım edenler olacaktır.

By.TRabZonLutm · 25 Mayıs 2024

necati' Alıntı:
Uzaktan ancak bu kadar. Forum arkadaşlarından yardım edenler olacaktır.

hocam ekledim

İndir imza xlsm

Dosyayı indir imza xlsm

dosya.co

son satırdan sonrar imza bloku hiçbir sekilde ilerlemiyor

necati · 25 Mayıs 2024

Tekrar merhaba,
4 numaralı mesajdaki kod kopyala yapıştır yaptığı için imza kutusunun adı devamlı değişiyor. Bu benim hatam. Kopyalama olayını yer değiştirme olarak ayarladım. Hatta bu konuda ısrarlı takipçi olduğunuza göre birkaç seçenek daha hazırlıyorum.

Kod:

Sub imza_Kutu()
Dim imz As Range

For Each resim In ActiveSheet.Shapes
    If resim.Name = "1 Metin kutusu" Then
        Set imz = Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
        resim.Top = imz.Top
        resim.Left = imz.Left
    End If
Next
End Sub

necati · 25 Mayıs 2024

İmza kaşe bloku ile ilgili 3 adet örnek daha ekliyorum. Mümkün olduğunca font çeşitliliği eklendi. Bunlar üzerinde oynanarak kendi stilimizi elde edebiliriz.

Örnek 1
Hücreye düz yazı yazar gibi imza bloku eklemek:

Kod:

Sub imza_Duz_Yazi()
Dim imz As Range

Set imz = Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
With imz
    .Offset(0, 0).Resize(3, 3).Merge
    .Value = "ABC FİRMASI LTD. ŞTİ." & vbLf & "Ali Veli Selami" & vbLf & "Gn.Md."
    .Characters(1, 21).Font.Color = vbRed
    .Characters(1, 21).Font.Bold = True
    .Characters(22, Len(imz)).Font.Color = vbBlack
End With
End Sub

Örnek 2
Hücreye imza blokunu metin kutusu olarak eklemek:

Kod:

Sub imza_Kutu_Ekle2()
Dim imz As Range
Dim sh As Shape

With ActiveSheet
    On Error Resume Next
    .Shapes("imzam").Delete
    On Error GoTo 0

    Set sh = .Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 50, 150, 50)
    With sh
        .Select
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = "ABC FİRMASI LTD. ŞTİ." & Chr(13) & "Ali Veli Selami" & Chr(13) & "Gn.Md."
        .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextFrame.Characters.Font.Name = "Tahoma"
        .TextFrame.Characters.Font.Size = 10
        .TextFrame.Characters.Font.Bold = msoTrue
        .TextFrame2.TextRange.Paragraphs(2).Font.Size = 12
        .TextFrame2.TextRange.Paragraphs(2).Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Name = "imzam"
        Set imz = Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
        .Top = imz.Top
        .Left = imz.Left
        imz.Select
    End With
End With
End Sub

Örnek 3
Hücreye imza blokunu daha önceden klasöre kaydedilen kaşe resmi olarak eklemek:

Kod:

Sub imza_Resim()
Dim hcr As Range, PicFile As String, resim As Shape
Dim PicTop As Integer, PicLeft As Integer, PicW As Integer, PicH As Integer

With ActiveSheet
    On Error Resume Next
    .Shapes("imzam").Delete
    On Error GoTo 0
'imza resminin bulunduğu konum
    PicFile = ThisWorkbook.Path & "\" & "imzam.jpg"
    
    If Dir(PicFile) = Empty Then
        MsgBox "Resim bulunamadı..!", vbCritical
        Exit Sub
    End If
'Son satırdan 10 satır aşağıda ve 7. sütun hizasında
    Set hcr = .Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
    PicTop = hcr.Top
    PicLeft = hcr.Left
    PicW = 150  'imza genişliği
    PicH = 90   'imza yüksekliği
    Set resim = .Shapes.AddPicture(PicFile, True, True, PicLeft, PicTop, PicW, PicH)
    resim.Name = "imzam"
End With

End Sub

By.TRabZonLutm · 27 Mayıs 2024

necati' Alıntı:

İmza kaşe bloku ile ilgili 3 adet örnek daha ekliyorum. Mümkün olduğunca font çeşitliliği eklendi. Bunlar üzerinde oynanarak kendi stilimizi elde edebiliriz.

Örnek 1
Hücreye düz yazı yazar gibi imza bloku eklemek:

Kod:

Sub imza_Duz_Yazi()
Dim imz As Range

Set imz = Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
With imz
    .Offset(0, 0).Resize(3, 3).Merge
    .Value = "ABC FİRMASI LTD. ŞTİ." & vbLf & "Ali Veli Selami" & vbLf & "Gn.Md."
    .Characters(1, 21).Font.Color = vbRed
    .Characters(1, 21).Font.Bold = True
    .Characters(22, Len(imz)).Font.Color = vbBlack
End With
End Sub

Örnek 2
Hücreye imza blokunu metin kutusu olarak eklemek:

Kod:

Sub imza_Kutu_Ekle2()
Dim imz As Range
Dim sh As Shape

With ActiveSheet
    On Error Resume Next
    .Shapes("imzam").Delete
    On Error GoTo 0

    Set sh = .Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 50, 150, 50)
    With sh
        .Select
        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = "ABC FİRMASI LTD. ŞTİ." & Chr(13) & "Ali Veli Selami" & Chr(13) & "Gn.Md."
        .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextFrame.Characters.Font.Name = "Tahoma"
        .TextFrame.Characters.Font.Size = 10
        .TextFrame.Characters.Font.Bold = msoTrue
        .TextFrame2.TextRange.Paragraphs(2).Font.Size = 12
        .TextFrame2.TextRange.Paragraphs(2).Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Name = "imzam"
        Set imz = Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
        .Top = imz.Top
        .Left = imz.Left
        imz.Select
    End With
End With
End Sub

Örnek 3
Hücreye imza blokunu daha önceden klasöre kaydedilen kaşe resmi olarak eklemek:

Kod:

Sub imza_Resim()
Dim hcr As Range, PicFile As String, resim As Shape
Dim PicTop As Integer, PicLeft As Integer, PicW As Integer, PicH As Integer

With ActiveSheet
    On Error Resume Next
    .Shapes("imzam").Delete
    On Error GoTo 0
'imza resminin bulunduğu konum
    PicFile = ThisWorkbook.Path & "\" & "imzam.jpg"
   
    If Dir(PicFile) = Empty Then
        MsgBox "Resim bulunamadı..!", vbCritical
        Exit Sub
    End If
'Son satırdan 10 satır aşağıda ve 7. sütun hizasında
    Set hcr = .Cells(Cells(Rows.Count, 1).End(3).Row + 10, 7)
    PicTop = hcr.Top
    PicLeft = hcr.Left
    PicW = 150  'imza genişliği
    PicH = 90   'imza yüksekliği
    Set resim = .Shapes.AddPicture(PicFile, True, True, PicLeft, PicTop, PicW, PicH)
    resim.Name = "imzam"
End With

End Sub

Çok teşekkür ediyorum. Deneyeceğim