• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Farklı Kaydet Butonu Ekleme

35 nolu mesajdaki kod makroları siliyor oysa siz silinmesini istemiştiniz. Eğer makrolar silinmiyecekse 35 nolu mesajdaki kodun içindeki aşağıdaki bölümü siliniz.

For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(ModX.Name).C odeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
Next
Genişletmek için tıkla ...
 
merhaba elimde bir dosya var buna bir kaydet butonu ekledim buna tıklayıp sayfayı pdf olarak kaydetmek mümkünmü accaba yardımlarınız için tşk.
 

Ekli dosyalar

gokhan1' Alıntı:
merhaba elimde bir dosya var buna bir kaydet butonu ekledim buna tıklayıp sayfayı pdf olarak kaydetmek mümkünmü accaba yardımlarınız için tşk.
Genişletmek için tıkla ...

Bu kodu denermisiniz.

Kod: 
Sub farklı_kaytet_pdf()
dosya_adı = Cells(6, "b").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(yer & " Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
Set Klasor = CreateObject("shell.application").browseforfolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.Items.Item.Path
If Right(Kaynak, 1) <> "\" Then
Kaynak = Kaynak & "\"
End If
yer = Kaynak & dosya_adı
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Range("A1:K31").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yer, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub
 
cevabınız için teşekürler. şöyle bi hata verdi(sarı olarak yanıyor);

Range("A1:K31").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yer, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

belki basit bi şeydir ama makrolar hakkında fazla bilgim yok kusura bakmayın..birde dosya ismini kaydederken b6 daki firma ismi ne ise onu verebilirmiyiz. tekrar teşekürler..
 
Son düzenleme:
gokhan1' Alıntı:
cevabınız için teşekürler. şöyle bi hata verdi(sarı olarak yanıyor);

Range("A1:K31").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yer, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

belki basit bi şeydir ama makrolar hakkında fazla bilgim yok kusura bakmayın..birde dosya ismini kaydederken b6 daki firma ismi ne ise onu verebilirmiyiz. tekrar teşekürler..
Genişletmek için tıkla ...

43 nolu mesajdaki kodu yeniden düzenledim.
Ancak aynı hatayı yine alacaksınız. konuyu iyi takip etmiş olsaydınız bu kodun ofis 2003 de çalışmıyacağını fark ederdiniz.
 
excel 2007 de çalıştığını atlamışım kusura bakmayın ben bu işlemi 2003 de yapmak istiyorum bunun içiin bir öneriniz veya yararlanacağım bir kaynak warmı??teşk..
 
gokhan1' Alıntı:
excel 2007 de çalıştığını atlamışım kusura bakmayın ben bu işlemi 2003 de yapmak istiyorum bunun içiin bir öneriniz veya yararlanacağım bir kaynak warmı??teşk..
Genişletmek için tıkla ...

Bu kodlar 2003 de çalışmaz

2007 veya daha üs versiyon kullanmanız gerekiyor.
 
selamlar makroyu kullandım ama

Kaynak = Klasor.Items.Item.Path şu noktada bier sorun cıkıyor. yardımcı olabilir misiniz?
 
sinemgundogdu' Alıntı:
selamlar makroyu kullandım ama

Kaynak = Klasor.Items.Item.Path şu noktada bier sorun cıkıyor. yardımcı olabilir misiniz?
Genişletmek için tıkla ...

Kodun o bölümü hedef klasörü gösteriyor kayıt yapacağınız bölüm bilgisayarınızda kısıtlamalı ise muhtemelen o bölümde veya başka bölümde hata verecektir.Kodu kısıtlama olmayan bilgisayarda deneyin.
 
halit3' Alıntı:
Kodun o bölümü hedef klasörü gösteriyor kayıt yapacağınız bölüm bilgisayarınızda kısıtlamalı ise muhtemelen o bölümde veya başka bölümde hata verecektir.Kodu kısıtlama olmayan bilgisayarda deneyin.
Genişletmek için tıkla ...

masaüstüne kaydetmeyince sorun duzeldi, peki dosyayı hali hazırda bulundugu yere kaydedebilir miyim? yani dizin seçmeden, direk kendi bulundugu dizine pdf olarak kaydedecek.
 
sinemgundogdu' Alıntı:
masaüstüne kaydetmeyince sorun duzeldi, peki dosyayı hali hazırda bulundugu yere kaydedebilir miyim? yani dizin seçmeden, direk kendi bulundugu dizine pdf olarak kaydedecek.
Genişletmek için tıkla ...


kod

Kod: 
Sub farklı_kaytet_pdf()
dosya_adı = Cells(6, "b").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
Range("A1:K31").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub
 
halit3' Alıntı:
kod

Kod: 
Sub farklı_kaytet_pdf()
dosya_adı = Cells(6, "b").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
Range("A1:K31").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub
Genişletmek için tıkla ...

Range("A1:K31") yerine son satırı seç ifadesini ekleyebilir miyiz peki?
 
slm.

ekte dosyada exceli xls. olarak 2 veya üç dosya içine faklı kaydetmek .istiyorum.
teşekkür ederim
 

Ekli dosyalar

halit3 hocam maşaallah bilgi deryasısınız vermiş olduğunuz bilgiler için sağolun.
 
Merhaba,

Ekteki exel şablonuna bir türlü farklı kaydet ve pdf olarak kaydet butonu ekleyemedım.Çok okudum ama temel olarak daha ogrenmem gereken cok sey var.Şimdilik bana yardımcı olabilecek bir arkadaş varmı acaba?

Farkılı Kaydet Butonuna Bastıgımda KONTEYNER ADI: kısmın karşısındaki hücre adını vermesini istiyorum aynı şekilde pfd içinde geçerli.Şimdiden çok teşekkür ederim.
 

Ekli dosyalar

caneryamac' Alıntı:
Merhaba,

Ekteki exel şablonuna bir türlü farklı kaydet ve pdf olarak kaydet butonu ekleyemedım.Çok okudum ama temel olarak daha ogrenmem gereken cok sey var.Şimdilik bana yardımcı olabilecek bir arkadaş varmı acaba?

Farkılı Kaydet Butonuna Bastıgımda KONTEYNER ADI: kısmın karşısındaki hücre adını vermesini istiyorum aynı şekilde pfd içinde geçerli.Şimdiden çok teşekkür ederim.
Genişletmek için tıkla ...

KOd:

Kod: 
Sub farklı_kaytet_pdf()
dosya_adı = Cells(4, "H").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If

Kayıt_Yeri = CreateObject("wscript.Shell").SpecialFolders("Desktop") & "\" & dosya_adı & Format(Now, " ddmmyy hhss")
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
Range("A1:U20").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Kayıt_Yeri, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

Sub farklıkaydetexcel()
Dim Kayıt_Yeri As String
Dim flk, uzanti, dosya
dosya = ThisWorkbook.FullName
dosya_adı = Cells(4, "H").Value

Set flk = CreateObject("Scripting.FileSystemObject")
uzanti = flk.GetExtensionName(dosya)  ' uzantı buluyor
ThisWorkbook.Save
Application.DisplayAlerts = False
Kayıt_Yeri = CreateObject("wscript.Shell").SpecialFolders("Desktop") & "\" & dosya_adı & Format(Now, " ddmmyy hhss")
flk.CopyFile dosya, Kayıt_Yeri & "." & uzanti
MsgBox "Dosyanız aşağıdaki isimle kayıt edilmiştir." & Chr(10) & Kayıt_Yeri, vbInformation, "U Y A R I"
Application.DisplayAlerts = True
End Sub

Eğer pdf kayıt yapmassa 7 nolu mesajdaki linkdeki dosyayı yüklemeniz gerekecek.

uyarı:
pdf kodu ofis 2003 de çalışmaz
 

Ekli dosyalar

halit3' Alıntı:
KOd:

Kod: 
Sub farklı_kaytet_pdf()
dosya_adı = Cells(4, "H").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If

Kayıt_Yeri = CreateObject("wscript.Shell").SpecialFolders("Desktop") & "\" & dosya_adı & Format(Now, " ddmmyy hhss")
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
Range("A1:U20").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Kayıt_Yeri, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

Sub farklıkaydetexcel()
Dim Kayıt_Yeri As String
Dim flk, uzanti, dosya
dosya = ThisWorkbook.FullName
dosya_adı = Cells(4, "H").Value

Set flk = CreateObject("Scripting.FileSystemObject")
uzanti = flk.GetExtensionName(dosya)  ' uzantı buluyor
ThisWorkbook.Save
Application.DisplayAlerts = False
Kayıt_Yeri = CreateObject("wscript.Shell").SpecialFolders("Desktop") & "\" & dosya_adı & Format(Now, " ddmmyy hhss")
flk.CopyFile dosya, Kayıt_Yeri & "." & uzanti
MsgBox "Dosyanız aşağıdaki isimle kayıt edilmiştir." & Chr(10) & Kayıt_Yeri, vbInformation, "U Y A R I"
Application.DisplayAlerts = True
End Sub

Eğer pdf kayıt yapmassa 7 nolu mesajdaki linkdeki dosyayı yüklemeniz gerekecek.

uyarı:
pdf kodu ofis 2003 de çalışmaz
Genişletmek için tıkla ...



Üstadım Allah razı olsun sizden öğreneceğim çok şey var Allah'ın izni ile . Şuanda çok sardım ve sürekli okuyorum.Çok hevesliyim.Çok yardımcı oldun teşekkür ederim.Tekrar görüşmek dileğiyle..
 
caneryamac' Alıntı:
Üstadım Allah razı olsun sizden öğreneceğim çok şey var Allah'ın izni ile . Şuanda çok sardım ve sürekli okuyorum.Çok hevesliyim.Çok yardımcı oldun teşekkür ederim.Tekrar görüşmek dileğiyle..
Genişletmek için tıkla ...


Sub farklı_kaytet_pdf()
dosya_adı = Cells(9, "b").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
Range("A1:F100").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub




Üstadım yukarıdaki verilere istinaden bu pfd kaydet makro sunu farklı kaydet makro suna dönüştürebilir miyim?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst