Farklı kaydederken bazı VBA kodların çıkarılması

[serdenm]

Arkadaslar merhaba,

ekte yazmis oldugum ornekteki auto_open bolumunu incelermisiniz? dosya calistiginda webden veri alip kendisini o gunku tarih ve saat ile fakrli kaydetmektedir. ancak kodlar aynen durdugu icin farkli kaydedilen dosyayi da actigimda yine ayni islemi yaparak otomatik olarak webden veri alip farkli kaydetmektedir.

istedigim ise farkli kaydedilen dosyadaki auto_open olayinin iptali veya sadece webden alinan verilerin farkli kaydedilmesi...

tesekkurler.

 

[serdenm]

çözümü olan var mı?
nasıl halledebiliriz?

 

[Levent Menteşoğlu]

Bunun için modülleri silen kodlar kullanmak gerekecektir. Aşağıdaki linkte benzer kodlar mevcuttur.

http://www.excel.web.tr/viewtopic.php?p=67034#67034

 

[serdenm]

leventm tesekkur ederim.

ancak kayit etmesine ragmen cikista tekrar "degisiklikleri kaydetmek istiyormusunuz?" diyor!

ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")
ActiveWorkbook.SaveAs ("c:\piyasalar\piyasalar " & Range("'ana menu'!f1"))
Application.Quit

burada cozum olarak su aklima geldi: yukaridaki satirlari module 2 isicnde sun son() icine yazacagim. boylece sadece module1 silinmis olacak ve cikista soru sormayacak. peki module 1 deki sub'a hangi komutu yazmaliyim ki module 2 deki sub son()'a gitsin? veya onu calistirsin. run,start,goto vs.? mantığını biliyorum ama uygulamada daha zayıfım...
tesekkurler.

 

[Levent Menteşoğlu]

Application.quit satırından önce application.save satırını ekleyerek deneyin birde.

 

[serdenm]

ama o zaman ana dosyanında kodları silinmez mi?
deneyecegim.ok,

birde genel bilgi olmasi acisindan belirli bir modulun belirli bir sub ini calistirmak icin icin nasil komut yazabilirim?

ornek:
sub a()
...
kodlar
...
(modul2'de sub c ()'ye git)
end sub

sub b ()
kodlar
end sub

 

[Levent Menteşoğlu]

ama o zaman ana dosyanında kodları silinmez mi?

Dosyayı saveas ile kaydettiğinizde eski dosya kapanır ve yeni isimle kaydedilen dosya açık kalır ve kaydedilen dosyada bu olur. Siz yinede bir yedek dosya üzerinde denemenizi yapın bence.

Bir makroyu çalışmak için, kod içinde sadece makronun adını yazmak yeterlidir.

sub a()
...
kodlar
...
c
end sub

 

[serdenm]

cok tesekkur ederim.
artik bende bazi basit makto sorularina cevap verebiliyorum.
forum sayesinde excel bilgim dahada artiyor...

 

[serdenm]

sayin leventm,

application.save de denedim yinede kaydetmek istiyormusunuz? diye soruyor.

bu dosyayi zamanlanmis gorev olarak calistiracagim icin hicbisey sormadan kaydedip kapanmasi gerekiyor.
module2 deki kod:
Sub son()

ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")

ActiveWorkbook.SaveAs ("c:\piyasalar\piyasalar " & Range("'ana menu'!f1"))
Application.Save
Application.Quit

End Sub

buna ragmen yinede sormasi sacma degil mi?

 

[Levent Menteşoğlu]

Biraz garip bir durum anlayamadım. Birde kodların en üstüne ilk satır olarak aşağıdaki satırı yazarak denermisiniz.

Application.DisplayAlerts = False

 

[serdenm]

bu sefer hic bir uyari vermedi ama modul1 i de silmedi. bu yuzden yine basa donmus olduk. module 2 nin son hali soyle:

Sub son()
Application.DisplayAlerts = False
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")

ActiveWorkbook.SaveAs ("c:\piyasalar\piyasalar " & Range("'ana menu'!f1"))
Application.Save
Application.Quit

End Sub

 

[Levent Menteşoğlu]

Sorun module silindikten sonrada kod çalıştırıldığından kaynaklanıyor. Bu durumda dosyayı kapatan satırı iptal edip elle kapatacaksınız. Yada farklı bir kopyalama yöntemi oluşturulacak.

 

[serdenm]

farkli mantik olustursak. mesela var olan dosyayi modul silerek save as yapmak yerine yeni bir xls dosyasi olustursak nasil olur? dosyanin ismi"c:\piyasalar\piyasalar " & Range("'ana menu'!f1"))
olacak.

boylece yeni olusacak dosyada hic bir kod olmaz ve cikistada soru sormaz (umarim).

bu dosyayi zamanlanmis gorev olarak calistiracagim icin hicbisey sormadan acilip, verileri alip, kaydedip kapanmasi gerekiyor. ...

leventm sizi mesgul ediyorum, kusura bakmayin... :?

 

[serdenm]

yardimci olurmusunuz? cok merak ediyorum, nasil cozecegiz? :?

 

[Levent Menteşoğlu]

Öncelikle auto_open makronuza son iki satı olarak aşağıdaki satırları ilave edin.

[vb:1:f884b825bb]Sub auto_open()
.
.
.
.
ActiveWorkbook.SaveAs ("c:\piyasalar\piyasalar " & Range("'ana menu'!f1") & ".xls")
Application.Quit
End sub
[/vb:1:f884b825bb]

Sonrada Thisworkbook sayfasına aşağıdaki kodu kopyalayın.

[vb:1:f884b825bb]Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")
ActiveWorkbook.Save
End Sub
[/vb:1:f884b825bb]

 

[algil]

Merhaba Serdenm
Aşagıdakiler daha önceden yaptığım bir çalışmanın makrosuz yeni dosya oluşturmada kullandığım kodlardır. Belki yardımcı olur.

Private Sub CommandButton3_Click()
Dim dsy
dsy = InputBox("Lütfen LEAD TIME'a ait ayın adını giriniz?", "Lead Time Dosyası Oluşturma", Format(Now, "mmmm_yyyy"))
If dsy = Cancel Then Exit Sub
On Error GoTo 10
MkDir "C:\LEAD TİME\" & dsy
Set NewBook = Workbooks.Add
    With NewBook
        .SaveAs "C:\LEAD TİME\" & dsy & "\" & "Lead_time_" & dsy & ".xls"
    End With
    Windows("LEAD TİME.xls").Activate
    Cells.Select
    Selection.Copy
    Windows("Lead_time_" & dsy & ".xls").Activate
    ActiveSheet.Paste
    Range("A2").Select
    Range("Z1:AG9").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Windows("LEAD TİME.xls").Activate
    Range("A2").Select
    ActiveWorkbook.Save
Unload UserForm1
Exit Sub
10:
MsgBox "Dosya ismini kontrol edip tekrar deneyiniz.", vbExclamation, "UYARI!!!!!!!"
End Sub

 

[serdenm]

merhaba leventm
mesajinizi sonradan gordum problemi soyle hallettim:

module1'e asagidakini ekledim:
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")

module2 ise:
Sub son()
Application.DisplayAlerts = False


ActiveWorkbook.SaveAs ("c:\piyasalar\piyasalar " & Range("'ana menu'!f1"))
Application.Save
Application.Quit

End Sub

oldugunda problem halloldu.
TEsekkur ederim.

 

[serdenm]

merhaba algil,

yazdiginiz kodla farkli bir mantik ile ayni problem cozulebilir. kodunuzu deneyecegim.

cok tesekkurler.

 

[serdenm]

sayin leventm sizin koduda denedim. cok gusel calisiyor.

tesekkur ederim.

 

[serdenm]

SONUC:
LEVENTM VE ALGİN'İN VERDİGİ KODLAR YARDIMI İLE:

Workbooks.Add
Windows("p1.xls").Activate
Sheets("piyasalar " & Range("'ana menu'!f1")).Select
Sheets("piyasalar " & Range("'ana menu'!f1")).Move Before:=Workbooks("Kitap1").Sheets(1)
Windows("p1.xls").Activate
Sheets("ana menu").Select
Sheets("ana menu").Copy Before:=Workbooks("Kitap1").Sheets(1)
ActiveWorkbook.SaveAs ("c:\piyasalar\piyasalar " & Range("'ana menu'!f1") & ".xls")
ActiveWorkbook.Close

Windows("p1.xls").Activate
Application.DisplayAlerts = False

Application.Quit

ŞEKLİNDE PROBLEM ÇÖZÜLMÜŞTÜR. :keyif:
BURADA İLGİN ARKADAŞIMIZIN VERDİĞİ ÖRNEKTEN FARKLI OLARAK HÜCRE KOPYALAMK YERİNE SAYFAYI KOMPLE TAŞIDIM. BÖYLECE KODLAR KOPYALANMAMIŞ OLDU.
İYİ GECELER.