[Yardım]  Excel seçili alanı .xlsx yada .xls olarak kaydetme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Excel seçili alanı .xlsx yada .xls olarak kaydetme

İleti#1)  uqurozdemir » 12 Nis 2018 14:54

Merhaba Arkadaşlar,

Aşağıda bulunan kodları yazdığım da PDF olarak kaydetmekte. " Dosya_Adi = Yol & Dosya_Adi & ".pdf" " olan yeri ".xlsx" olarak değiştiriyorum fakat bu seferde "deneme.xlsx.pdf" olarak kaydediyor. Yardımcı olabilirsiniz çok sevinirim.
Kod: Tümünü seç
Sub SEÇİLEN_ALANI_PDF_KAYDET()
    Dim Dosya_Adi As Variant, Yol As String, Sayfa_Yonu As Byte
    Dim Onay_Dikey As Byte, Onay_Yatay As Byte, Kayit_Yeri As Object
    Dim K1 As Workbook, S1 As Worksheet, S2 As Worksheet
   
    Set Kayit_Yeri = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen dosyanızı kayıt etmek istediğiniz bölümü seçiniz !", 1)
    If Not Kayit_Yeri Is Nothing Then
        Yol = Kayit_Yeri.Self.Path & "\"
    Else
        MsgBox "Kayıt etmek istediğiniz bölümü seçmediğiniz için işleminiz iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
   
    Dosya_Adi = InputBox("Lütfen dosya adını giriniz!", "Dosya Adı")
    If Dosya_Adi = "" Then
        MsgBox "Dosya adı girmediğiniz için işleminiz iptal edilmiştir."
        Exit Sub
    End If
   
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
    S1.Copy , K1.Worksheets(K1.Worksheets.Count)
    Set S2 = ActiveSheet
   
    Dosya_Adi = Yol & Dosya_Adi & ".pdf"
   
    Sayfa_Yonu = S2.PageSetup.Orientation
   
    If Sayfa_Yonu = 1 Then
        Onay_Dikey = MsgBox("Sayfa yönü dikey olarak ayarlıdır. Değiştirmek istiyorsanız evet seçeneğini tıklayınız.", vbExclamation + vbYesNo)
        If Onay_Dikey = vbYes Then
            S2.PageSetup.Orientation = 2
        End If
    Else
        Onay_Yatay = MsgBox("Sayfa yönü yatay olarak ayarlıdır. Değiştirmek istiyorsanız evet seçeneğini tıklayınız.", vbExclamation + vbYesNo)
        If Onay_Yatay = vbYes Then
            S2.PageSetup.Orientation = 1
        End If
    End If
   
    With S2.PageSetup
        .PrintArea = Selection.Address
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Dosya_Adi, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True

    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True

    S1.Select

    Set K1 = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
Kullanıcı avatarı
uqurozdemir
Yeni Başlamış
 
Kayıt: 28 Tem 2016 11:26
Meslek: Öğrenci
Yaş: 23
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Sancaktepe

Cevap: Excel seçili alanı .xlsx yada .xls olarak kaydetme

İleti#2)  Ali ÖZ » 12 Nis 2018 16:37

Kod: Tümünü seç
Private Sub CommandButton1_Click()
Selection.Copy
Set kaydet = Workbooks.Add
Application.DisplayAlerts = False
kaydet.Sheets(1).Range("a1").PasteSpecial
kaydet.Close True
End Sub
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 12:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 37
İleti: 9309
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Excel seçili alanı .xlsx yada .xls olarak kayd

İleti#3)  uqurozdemir » 12 Nis 2018 18:02

Ali ÖZ yazdı:
Kod: Tümünü seç
Private Sub CommandButton1_Click()
Selection.Copy
Set kaydet = Workbooks.Add
Application.DisplayAlerts = False
kaydet.Sheets(1).Range("a1").PasteSpecial
kaydet.Close True
End Sub


Ali Bey,

Cevabınız için çok teşekkür ederim fakat belirtmiş olduğunuz kodları hangi kısımla değiştirmem gerektiğini tam anlayamadım.
Kullanıcı avatarı
uqurozdemir
Yeni Başlamış
 
Kayıt: 28 Tem 2016 11:26
Meslek: Öğrenci
Yaş: 23
İleti: 15
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Sancaktepe


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Google [Bot] ve 1 misafir

Bumerang - Yazarkafe