VBA İle Hem Excel Hemde PDF Olarak Farklı Kaydetme

K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
Kod: 
Sub Düğme1_Tıklat()
    Dim w As Long
    For w = 1 To Sheets.Count
        Sheets(w).UsedRange = Sheets(w).UsedRange.Value
    Next w
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs _
      ThisWorkbook.Path & Chr(92) & _
        Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, Chr(46)) - 1) & Format(Date, "_yyyy-mm"), _
      xlOpenXMLWorkbook
End Sub
Kod genel olarak çalışıyor fakat benim vba bilgim pek olmamasından kaynaklı düzenleme yapamıyorum.

1- Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, Chr(46)) - 1) & Format(Date, "_yyyy-mm"), _
Dosya isminin sonuna yıl ve ay ekleyerek kaydediyor ama benim istediğim; Dosya ismi yerine F8 Hücresindeki değer boşluk bırakıp F9 Hücresindeki değeri yazarak kaydetmesi.

2- İlgili excel neredeyse oraya dosyayı excel olarak kaydediyor. Şuanki hali ile makrosuz ve formülsüz farklı kaydediyor burda değişiklik istemiyorum. Sadece extra olarak PDF olarak aynı yere aynı isimlendirmeler ile kaydettirebilir miyiz acaba ?
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
Eğer excel ile pdf i ayrı olarak kaydedeceği yolu da belirleyebilir isek buda süper olur tabi hocam
 
T

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,778
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Merhaba Arkadaş,
Dosyayı yeni bir klasör açıp içine kayıt edin ve klasörün içine Pdf adlı bir klasör oluşturup dosyayı açıp makroyu deneyiniz.
İyi çalışmalar
 

Ekli dosyalar

K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
Tevfik_Kursun' Alıntı:
Merhaba Arkadaş,
Dosyayı yeni bir klasör açıp içine kayıt edin ve klasörün içine Pdf adlı bir klasör oluşturup dosyayı açıp makroyu deneyiniz.
İyi çalışmalar
Genişletmek için tıkla ...
Hocam sizin kod hata veriyor ben biraz araştırarak birleştirmeler yaptım kod tam olarak istediklerimi yapıyor ama farklı kaydet yapmıyor. Makroyu çalıştırınca asıl dosya gidiyor yerine makronun sonucunu verdiği excel kalıyor.

Makroyu çalıştırınca saveas yapıp aynı dosya ile nasıl devam etmesi için bir kod düzeltmesi gerekli.

Şuan aşağıdaki kod tamamen istediklerimi yapıyor fakat farklı kaydettiği dosyaya geçip ilk çalıştığım dosyayı kapatıyor.

Kod: 
Private Sub Yener()
Dim sh As Worksheet
Set sh = ActiveSheet
Set ds = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\" & ActiveSheet.Name
isim = sh.Range("F9").Value & " - " & sh.Range("F8").Value & " - " & Format(Now, "yyyy-mm-dd")

Dim w As Long
For w = 1 To Sheets.Count
Sheets(w).UsedRange = Sheets(w).UsedRange.Value
Next w
Application.DisplayAlerts = False
ThisWorkbook.SaveAs _
ThisWorkbook.Path & Chr(92) & _
sh.Range("F9").Value & " - " & sh.Range("F8").Value & " - " & Format(Now, "yyyy-mm-dd")

Application.Dialogs(xlDialogPrint).Show

kontrol = ds.FolderExists(yol)
If kontrol <> True Then
ds.CreateFolder yol
End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol _
& "\" & isim & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

ActiveWorkbook.Save
End Sub
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
Kısacası Farklı kaydetme işlemlerini yapıyor fakat ana dosyamı kapatıp farklı kaydettiği excel dosyasına geçiyor. Ben sadece farklı excel dosyasını kaydetmesini istiyorum. Asıl açık olan excel dosyamda kalmak istiyorum.
 
Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki konuyu inceler misiniz? Benim paylaştığım dosyada istediğiniz özellikler mevcut.

Soru - Veri Doğrulamada Otomatik Tamamlama

Merhaba veri doğrulama yapıp içinde arama yapmak istedim bu kodu kullandım fakat =KAYDIR(Sayfa2!$B$1;(KAÇINCI(A5&"*";Sayfa2!$B$1:$B$15;0))-1;;EĞERSAY(Sayfa2!$B$1:$B$150;A5&"*")) A5 satırında zım yazıp aratınca zımba içeren satırların arasındaki diğer satırlarıda alıyor. Sadece zım içerenleri...
www.excel.web.tr www.excel.web.tr
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
YUSUF44' Alıntı:
Aşağıdaki konuyu inceler misiniz? Benim paylaştığım dosyada istediğiniz özellikler mevcut.

Soru - Veri Doğrulamada Otomatik Tamamlama

Merhaba veri doğrulama yapıp içinde arama yapmak istedim bu kodu kullandım fakat =KAYDIR(Sayfa2!$B$1;(KAÇINCI(A5&"*";Sayfa2!$B$1:$B$15;0))-1;;EĞERSAY(Sayfa2!$B$1:$B$150;A5&"*")) A5 satırında zım yazıp aratınca zımba içeren satırların arasındaki diğer satırlarıda alıyor. Sadece zım içerenleri...
www.excel.web.tr www.excel.web.tr
Genişletmek için tıkla ...
Hocam farklı kaydettiği excelde formüller kalıyor. Formülsüz şekilde olması için ne yapmamız lazım
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
İlk mesajda verdiğiniz koddan yola çıkarak

Activesheet.UsedRange = Activesheet.Usedrange.Value

satırını uygun bir yere ekleyerek deneyin.
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
YUSUF44' Alıntı:
İlk mesajda verdiğiniz koddan yola çıkarak

Activesheet.UsedRange = Activesheet.Usedrange.Value

satırını uygun bir yere ekleyerek deneyin.
Genişletmek için tıkla ...
Kod: 
Sub xlsxyap()
    Application.DisplayAlerts = False
    Dim sPath As String
    ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
    sPath = ThisWorkbook.Path & Application.PathSeparator & [F9] & " " & [F8] & Format(Date, " dd.m.yyyy")
    
    ThisWorkbook.SaveCopyAs sPath & ".xlsm"
    If Dir(sPath & ".xlsx") <> "" Then
        Set eski = Application.Workbooks.Open(sPath & ".xlsx")
        eski.Close
        Kill sPath & ".xlsx"
    End If
    Dim Wb As Workbook
    Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
    Wb.Sheets(1).Shapes.Range(Array("Button 1")).Delete
    ActiveSheet.Shapes.Range(Array("Button 2")).Delete
    Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
    Wb.Close SaveChanges:=False
    Kill sPath & ".xlsm"
    Application.DisplayAlerts = True
End Sub
Hocam kodunuz bu şekilde tam istediğim gibi oldu. Sadece bir hata alıyorum görseli aşağıda

235035
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
Hocam şuanki hali ile benim ana dosyam formüllü fakat ana dosyamıda formülsüz hale getiriyor. Ana dosyamın formüllerini bozmadan farklı kaydedeceği dosyada formül ve makronun olmaması lazım
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi deneyin. Denemeden önce yedekleme yapmayı unutmayın. Bir de kodda Button silmeyle ilgili satırları kontrol edin, gereksizse iptal edin.

PHP: 
Sub xlsxyap()
    Application.DisplayAlerts = False
    Dim sPath As String
    sPath = ThisWorkbook.Path & Application.PathSeparator & [F9] & " " & [F8] & Format(Date, " dd.m.yyyy")
    
    ThisWorkbook.SaveCopyAs sPath & ".xlsm"
    If Dir(sPath & ".xlsx") <> "" Then
        Set eski = Application.Workbooks.Open(sPath & ".xlsx")
        eski.Close
        Kill sPath & ".xlsx"
    End If
    Dim Wb As Workbook
    Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
    For w = 1 To Wb.Sheets.Count
        Wb.Sheets(w).UsedRange = Wb.Sheets(w).UsedRange.Value
    Next w
    Wb.Sheets(1).Shapes.Range(Array("Button 1")).Delete
    'ActiveSheet.Shapes.Range(Array("Button 2")).Delete
    Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
    Wb.Close SaveChanges:=False
    Kill sPath & ".xlsm"
    Application.DisplayAlerts = True
End Sub
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
YUSUF44' Alıntı:
Aşağıdaki gibi deneyin. Denemeden önce yedekleme yapmayı unutmayın. Bir de kodda Button silmeyle ilgili satırları kontrol edin, gereksizse iptal edin.

PHP: 
Sub xlsxyap()
    Application.DisplayAlerts = False
    Dim sPath As String
    sPath = ThisWorkbook.Path & Application.PathSeparator & [F9] & " " & [F8] & Format(Date, " dd.m.yyyy")
   
    ThisWorkbook.SaveCopyAs sPath & ".xlsm"
    If Dir(sPath & ".xlsx") <> "" Then
        Set eski = Application.Workbooks.Open(sPath & ".xlsx")
        eski.Close
        Kill sPath & ".xlsx"
    End If
    Dim Wb As Workbook
    Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
    For w = 1 To Wb.Sheets.Count
        Wb.Sheets(w).UsedRange = Wb.Sheets(w).UsedRange.Value
    Next w
    Wb.Sheets(1).Shapes.Range(Array("Button 1")).Delete
    'ActiveSheet.Shapes.Range(Array("Button 2")).Delete
    Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
    Wb.Close SaveChanges:=False
    Kill sPath & ".xlsm"
    Application.DisplayAlerts = True
End Sub
Genişletmek için tıkla ...
Teşekkürler Hocam çalıştı.
 
K

KYenerSelvi

Katılım
28 Eylül 2018
Mesajlar
112
Excel Vers. ve Dili
Office Pro Plus 2016 Türkçe
Altın Üyelik Bitiş Tarihi
09-02-2023
Hocam aşağıdaki kod tüm işlerimi görüyor fakat şöyle bir sorunum var. Ana dosyamı kaydederken içerisindeki resim ve biçimle kaydetmiyor. Ana dosyadaki logo ve yazdırma görünüm biçimi ile farklı kaydetmesi mümkün müdür.

Kod: 
Sub YenerExcel()
    Set HucreAraligi = Nothing
    Set sh = ActiveSheet
    Set HucreAraligi = ActiveSheet.UsedRange.Cells
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    Set Kitap = Workbooks.Add(xlWBATWorksheet)
HucreAraligi.Copy
        With Kitap.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial Paste:=xlPasteValues
            .Cells(1).PasteSpecial Paste:=xlPasteFormats
            .Cells(1).Select
        Application.CutCopyMode = False
        End With

isim = sh.Range("F9").Value & " " & sh.Range("F8").Value & ".xlsx"
yol = "***"
        With Kitap
            .SaveAs Filename:=yol & isim, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
            .Close SaveChanges:=False
        End With
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst