Textbox icerisindekini makroda kullanma

[Freddyadu]

Merhaba arkadaşlar.

Excelde yeniyim egitimleri izleyerek bir kod yazdim ama hata aliyorum.

Sayfaya bir buton atadim butona tikladigimda sayfayi pdf olarak kaydedip dosya ismini textbox icerisinden almasini istiyorum nasil bir kod yazmam gerekir.

 

[murat_fidan]

Merhaba arkadaşlar.

Excelde yeniyim egitimleri izleyerek bir kod yazdim ama hata aliyorum.

Sayfaya bir buton atadim butona tikladigimda sayfayi pdf olarak kaydedip dosya ismini textbox icerisinden almasini istiyorum nasil bir kod yazmam gerekir.

Private Sub CommandButton1_Click()
    Dim DosyaAdi As String
    Dim DosyaYolu As String
    Dim NewSheet As Worksheet
 
    DosyaAdi = Sheets("Sayfa1").OLEObjects("TextBox1").Object.Text
    DosyaYolu = Environ("USERPROFILE") & "\Desktop\" & DosyaAdi & ".pdf"
    
    Set NewSheet = ThisWorkbook.Sheets.Add
    
    Sheets("Sayfa1").Cells.Copy Destination:=NewSheet.Cells
    
    For Each obj In NewSheet.Shapes
        obj.Delete
    Next obj
    
    NewSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=DosyaYolu, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    Application.DisplayAlerts = False
    NewSheet.Delete
    Application.DisplayAlerts = True
    
    MsgBox "PDF dosyası kaydedildi."
End Sub

 

[Freddyadu]

Hocam hızlı cevabın için çok teşekkürler.

Kodu denedim fakat Worksheet sınıfının oleobjects özelliği alınamıyor diye hata verdi. kod içerisindeki sayfa 1 ve textbox1 yazan kısımları kendi dosyama göre değiştirdim ama olmadı

 

[Freddyadu]

Benim yazdığım kod bu şekildeydi hocam

Sub Pdfkaydet()

Path = Worksheets("Ayarlar").Range("B1").Text

Model = Worksheets("Material removal").Range("textbox52").Value

Seri = Worksheets("Material removal").Range("textbox51").Value

Worksheets("Material removal").ExportAsFixedFormat xlTypePDF, Filename:=Path & Model & "_" & Seri & ".pdf"

End Sub

 

[Korhan Ayhan]

Örnek dosya paylaşırsanız daha net cevaplar alabilirsiniz.

 

[Freddyadu]

merhaba altın üye oldum sanırım onaylanınca dosya yükleyebilirim.

 

[murat_fidan]

Benim yazdığım kod bu şekildeydi hocam

Sub Pdfkaydet()

Path = Worksheets("Ayarlar").Range("B1").Text

Model = Worksheets("Material removal").Range("textbox52").Value

Seri = Worksheets("Material removal").Range("textbox51").Value

Worksheets("Material removal").ExportAsFixedFormat xlTypePDF, Filename:=Path & Model & "_" & Seri & ".pdf"

End Sub

textbox1 nesnesi sayfanızın üzerindemi,bende herhangi bir hata vermeden çalışıyor

 

[Freddyadu]

textbox1 nesnesi sayfanızın üzerindemi,bende herhangi bir hata vermeden çalışıyor

Yok hocam bendeki textbox51 ve 52 olan kısımları almak istiyorum hatta ikisinin arasında _ olmasınıda istiyorum altın üyelik onaylandıktan sonra dosya paylaşımı yapabilirim.

 

[Freddyadu]

Merhabalar;

Dosyayı ekledim.Dosya içerisinde birden fazla çalışma sayfası var ben birtanesi için denedim ama aslında hepsi için gerekiyor. 1 tanesi olsa diğerleri içinde ben yapabilirim.Yapmak istediğim şey sayfaya eklediğim butona basınca dosyayı pdf olarak kaydetmesi ve dosya ismini tool type_serial no kısmında yazılanları alarak kaydetmesi şimdiden çok teşekkürler

 

[Korhan Ayhan]

Merhaba,

Profilinizde yazan ofis sürümü ve dili bilgisini bizlerin profilindeki gibi revize etmenizi rica ederim.

Excel Vers. ve Dili Turkce

 

[Korhan Ayhan]

Deneyiniz.

Sub Pdfkaydet()
    Path = Worksheets("Ayarlar").Range("B1").Value & "\"
    Model = Worksheets("Material removal").Shapes("TextBox 52").TextFrame2.TextRange.Characters.Text
    Seri = Worksheets("Material removal").Shapes("TextBox 51").TextFrame2.TextRange.Characters.Text
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & Model & "_" & Seri & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
End Sub

 

[Freddyadu]

Deneyiniz.

Sub Pdfkaydet()
    Path = Worksheets("Ayarlar").Range("B1").Value & "\"
    Model = Worksheets("Material removal").Shapes("TextBox 52").TextFrame2.TextRange.Characters.Text
    Seri = Worksheets("Material removal").Shapes("TextBox 51").TextFrame2.TextRange.Characters.Text
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & Model & "_" & Seri & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
End Sub

Hocam çok teşekkür ederim ellerinize sağlık tam istediğim gibi çok sağolun.

 

[Freddyadu]

Merhabalar;

Yukarıda paylaşmış olduğum dosyaya kodu kullandım ve material removal olan sekmede çalıştı. Daha sonra kendim pneumatic olan sekmede kullandım onda da çalıştı fakat bugün ismi electric olan sekmede uygulamaya çalıştım ama hata veriyor hata resmini ekte iletiyorum. Sizce nerde hata yapmış olabilirim. Şimdiden çok teşekkürler.

 

[Korhan Ayhan]

Path-Model-Seri verilerinden birisi boş olabilir mi?

 

[Freddyadu]

Yok hocam aynı yerdeler textbox 53 ve 52 de yazılı veriler , path zaten ortak ayrı bir sekmede sadece kayıt konumu için duruyor

 

[Korhan Ayhan]

Peki hata mesajı nedir?

Mümkünse hata veren dosyanızı paylaşabilirmisiniz.

 

[Freddyadu]

Hata mesajını ve dosyanın son halini paylaştım hocam teşekkürler ilginiz için.

 

[Korhan Ayhan]

TextBox nesnelerindeki ifadenin sonunda TAB boşluğu verildiği için sorun oluşmuş.

Sub Pdfkaydet3()
    Path = Worksheets("Ayarlar").Range("B1").Value & "\"
    Model = Trim(Replace(Worksheets("Electric").Shapes("TextBox 53").TextFrame2.TextRange.Characters.Text, vbTab, ""))
    Seri = Trim(Replace(Worksheets("Electric").Shapes("TextBox 52").TextFrame2.TextRange.Characters.Text, vbTab, ""))
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & Model & "_" & Seri & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
End Sub

 

[Freddyadu]

Hocam çok teşekkürler tekrar sorunum çözüldü elinize sağlık