modül ve değişken dosya konumuna kayıt

zulfuernek · 3 Ağustos 2017

Sub PDF()
'
' PDF Makro
'

'
ChDir "C:\SOYLU\ze59500\Desktop\KASA YEDEKLERİ\PDF FORMATI"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\SOYLU\ze59500\Desktop\KASA YEDEKLERİ\PDF FORMATI\DENEME 1.pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub

yukarıdaki kodlarla pdf kaydetme makrosunu istediğim dosyaya kaydetmesi için oluşturdum.

SORU:
1) bu işlevi userformde command button 1 de nasıl çalıştıracağım?
2) C:\SOYLU\ze59500\Desktop\KASA YEDEKLERİ\PDF FORMATI\DENEME 1 Dosya yolundaki ze59500 değişkendir. yani hangi bilgisayar kurarsam o kişinin sicili olmakta.
bu değişkeni nasıl tanımlayabiliriz.
3) dosya ismi "DENEME1" değilde aktif shheetin ismiyle nasıl tanımlarız.

PLİNT · 3 Ağustos 2017

Merhaba
Aşağıdaki kodları kullanabilirsiniz.
"Userfom" da bulunan "Commandbutton" kod sayfasına ekler,
kırmızı bölümü ayarlarsınız
Mavi bölümler masaüstünde klasörler mevcut değilse oluştursun.

Kod:

[SIZE="2"]Private Sub CommandButton1_Click()
 Dim ds, cs As Object
 Dim gds
Set cs = CreateObject("Scripting.FileSystemObject")
    Set ds = CreateObject("WScript.Shell")
    gds = ds.SpecialFolders("Desktop")
 [COLOR="Red"]Sheets("Sayfa1").Activate[/COLOR]
[COLOR="Blue"]If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\PDF FORMATI") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & "PDF FORMATI"[/COLOR]
ChDir gds & "\KASA YEDEKLERİ\PDF FORMATI"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\PDF FORMATI\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub [/SIZE]

zulfuernek · 3 Ağustos 2017

hocam zaten masa üzerine klasör oluşturuyor. onda problemimiz yok. burdaki sorun şu pdf kayıt belgrsini değişken dosya yoluna masıl tanımlayacağım. bende ze59500 başka bişgisayarda ise mesela fg85610 dosya yolu

PLİNT · 3 Ağustos 2017

zulfuernek' Alıntı:
hocam zaten masa üzerine klasör oluşturuyor. onda problemimiz yok. burdaki sorun şu pdf kayıt belgrsini değişken dosya yoluna masıl tanımlayacağım. bende ze59500 başka bişgisayarda ise mesela fg85610 dosya yolu

Merhaba
Denedinizmi?

Kod:

    Set ds = CreateObject("WScript.Shell")
    gds = ds.SpecialFolders("Desktop")

"gds" tanımı hangi bilgisayarda ise masaüstü yolunu bulacaktır

zulfuernek · 3 Ağustos 2017

plınt hocam dediğinizi uyguladım.

Dim ds, cs As Object
Dim gds
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")
If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\PDF FORMATI") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & "PDF FORMATI"
ChDir gds & "\KASA YEDEKLERİ\PDF FORMATI"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\PDF FORMATI\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

yukarıdaki formülle. tam istediğim gibi oldu. hem klasörü açıyor hemde sekmenin ismiyle pdf olarak kaydediyor. harika oldu.
fakat bir problemi var. mesela bahsettiğimiz isimde dosya varsa formülde kırmızı alanla belitttiğim yer hata verişyyor. benim amacım burda şudur. eğer o isimde dosya varsa uyarı vermeden eski dosyanın yerine yenisini direk kaydetmesidir. yani eski dosyayı silerek yeni kaydettiğimi bırakmalı. aynı isimde dosya varsa tabi.

zulfuernek · 3 Ağustos 2017

hocam sanırım oldu. peki sorumu değişeyim.

txt ve xls olarak kaydetmesi için .pdf yi txt ypıyorum ama pdf olarak kaydediyor. bunun için ne yapmam gerekli

PLİNT · 3 Ağustos 2017

Merhaba
"txt" dosyası için
(kırmızı bölüm varsa aynı isimli dosya varsa silsin)

Kod:

[SIZE="2"]Private Sub CommandButton1_Click()
 Dim ds, cs As Object
 Dim gds
 Dim yol As String
Set cs = CreateObject("Scripting.FileSystemObject")
    Set ds = CreateObject("WScript.Shell")
    gds = ds.SpecialFolders("Desktop")
 Sheets("Sayfa1").Activate
If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\PDF FORMATI") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & "PDF FORMATI"
yol = gds & "\KASA YEDEKLERİ\PDF FORMATI"
ChDir yol
[COLOR="Red"]If cs.FileExists(yol & "\" & ActiveSheet.Name & ".txt") = True Then Kill yol & "\" & ActiveSheet.Name & ".txt"[/COLOR]
ActiveSheet.Copy
 ActiveWorkbook.SaveAs Filename:=gds & "\KASA YEDEKLERİ\PDF FORMATI\" & ActiveSheet.Name & ".txt", FileFormat _
        :=xlText, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False
End Sub [/SIZE]

"xlsx" uzantılı için

Kod:

[SIZE="2"]Private Sub CommandButton2_Click()

 Dim ds, cs As Object
 Dim gds
 Dim yol As String
Set cs = CreateObject("Scripting.FileSystemObject")
    Set ds = CreateObject("WScript.Shell")
    gds = ds.SpecialFolders("Desktop")
 Sheets("Sayfa1").Activate
If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\PDF FORMATI") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & "PDF FORMATI"
yol = gds & "\KASA YEDEKLERİ\PDF FORMATI"
ChDir yol
[COLOR="Red"]If cs.FileExists(yol & "\" & ActiveSheet.Name & ".xlsx") = True Then Kill yol & "\" & ActiveSheet.Name & ".xlsx"[/COLOR]
ActiveSheet.Copy
ActiveWorkbook.SaveAs yol & "\" & ActiveSheet.Name & ".xlsx"
ActiveWorkbook.Close 
End Sub

[/SIZE]

zulfuernek · 3 Ağustos 2017

hocam hepsi harika çalışıyor. emeğine sağlık.
ben bu üçündebiraz değişklik yapıp üçünüde tak butona atadım :

Dim ds, cs As Object
Dim gds
Dim yol As String
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\PDF FORMATI") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & "PDF FORMATI"
yol = gds & "\KASA YEDEKLERİ\PDF FORMATI"
ChDir yol
If cs.FileExists(yol & "\" & ActiveSheet.Name & ".txt"".pdf"".xls") = True Then Kill yol & "\" & ActiveSheet.Name & ".txt"".pdf"".xls"

ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=gds & "\KASA YEDEKLERİ\PDF FORMATI\" & ActiveSheet.Name & ".txt", FileFormat _
:=xlText, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False

MsgBox "Bilgiler Kaydedildi", vbInformation, "ANAKASA"

kodu bu şekilde ayarladım. emeğine sağlık sayın hocam

zulfuernek · 3 Ağustos 2017

hocam fakat şunu diyeyim son ufak bişr ricam. onuda halledersek mükemmel olucak. txt formatıyla kaydedşince bilgileri yazıyor sıorunsuz ancak satırdaki tab tuşları çok fazla aralıklı orjinali gibi gösteremezmiyiz.

zulfuernek · 3 Ağustos 2017

hocam az önce oldu şimdi olmuyor. anlamadım bişey yemin edrim kafayı yiyicem

zulfuernek · 3 Ağustos 2017

aynı anda 3 farklı formatta kaydetmeli

zulfuernek · 3 Ağustos 2017

modül bileşeniyle işi çözdüm hocam.

şimidi kaldı txt formatındaki fazla uzun ulan tab boşlukjlarına

PLİNT · 3 Ağustos 2017

zulfuernek' Alıntı:
aynı anda 3 farklı formatta kaydetmeli

Mavi bölüm aktif sayfa adıyla aynı tüm dosyaları silmek içindir
Önceki mesajınızdaki "Tab" sorunu için örnek dosya eklermisiniz?

Kod:

[SIZE="2"]Private Sub CommandButton1_Click()
Dim ds, cs As Object
Dim gds
Dim yol As String
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\PDF FORMATI") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & "PDF FORMATI"
yol = gds & "\KASA YEDEKLERİ\PDF FORMATI"
ChDir yol
[COLOR="Red"]Sheets("Sayfa1").Activate[/COLOR]
[COLOR="Blue"]For Each dosya In cs.GetFolder(yol).Files
If ActiveSheet.Name = cs.getbasename(dosya.Name) Then
Kill dosya
End If: Next[/COLOR]
ActiveSheet.Copy
 ActiveWorkbook.SaveAs Filename:=gds & "\KASA YEDEKLERİ\PDF FORMATI\" & ActiveSheet.Name & ".txt", FileFormat _
        :=xlText, CreateBackup:=False
ActiveSheet.SaveAs yol & "\" & ActiveSheet.Name & ".xlsx", 51

ActiveWorkbook.Close savechanges:=False

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\PDF FORMATI\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False 'true
MsgBox "Bilgiler Kaydedildi", vbInformation, "ANAKASA"

End Sub [/SIZE]

zulfuernek · 3 Ağustos 2017

sayın hocam akşam dosya eklemesini yapayım. işyerinde olduğum için dosya kayıt sitelerini açamıyorum.

tab sorunu derken şöyle ki;

dosyaları kaydediyor txt, pdf,xls olarak.

ancak mesela a1 hücresindeki değer ile b1 hücresindeki değer arasındaki boşluk çok fazla aralıklı txt dosyasında yani 1 tab boşluk yerine iki sütun arasında 3 veya 4 tab boşluk var. bunu tek tab olmasını sağlayabilirmiyiz.

saygılarımı sunarım hocama

zulfuernek · 4 Ağustos 2017

plint hocam dosyalar ektedir.

TXT FORMATI: http://dosya.co/o9q1e3j5s3s3/08.03.2017.txt.html
VBA ŞABLONU: http://dosya.co/5p5wws6xbhnt/ANAKASA_YENİ2.xlsm.html

ekler yukarıdadır. vba şablonunda anakasa userformunda yedekle derseniz. txt olarak kaydediyor. ve dikkat edi txt formatındada sütunlar arasında 4 er tane tab boşluğu mevcut.
üstelik ilk satırdada kayma yapmış. yani tutar uzunsa şablon uzunlukla beraber kayıyor. excel sayfasındaki gibi düzenli yapamazmıyız.

Ömer BARAN · 4 Ağustos 2017

Yanlış konu sayfasına yazdığım cevabı sildim.
.

modül ve değişken dosya konumuna kayıt

Uzman