kapatma makrosu

[GKMER]

1- Bir excel dosyası ile başka bir excel dosyası açıyorum bradaki makro ile bu dosyaya kopya alıp yeni isimli dosyayı açıyorum. kopya aldığım eski dosya kapanıyor fakat ilk açılan dosyanın kapanması için yazdığım kod işlem yapmıyor.
2- Bir excel dosyasındaki makro ile başka bir dosyanın açık olup olmadığını kontrol ederek açıksa kapatmasını değilse makronun durmasını sağlayan bir koda ihtiyacım var.

 

[Levent Menteşoğlu]

1-kodlarınızı yazarmısınız.

2-Aşağıdaki gibi bir kod yapısı kullanabilirsiniz.

[vb:1:17845ade84]On Error Resume Next
For a = 1 To Workbooks.Count
If Workbooks(a).Name = "Kitap6" Then
Workbooks(a).Close
GoTo 10
End If
Next
Exit Sub
10 MsgBox "dosya kapatıldı"[/vb:1:17845ade84]

 

[GKMER]

Sayın leventm bu kodları hep sizden alarak uyarlamaya çalıştım sorunlarımın çözümüne yardımlarınız için hepinize teşekkür ederim.

BU KOD İLE DOSYAYI TEXTBOX’A YAZILAN VERİLERİ HÜCREDE BİRLEÞTİREREK YENİ İSİMLE KAYDEDİYORUM.
Private Sub CommandButton3_Click()
Application.Visible = True
Sheets("kayıt").Activate
Sheets("kayıt").Range("a1:b44").clear
If Texthakno.Value <> "" Then
Cells(1, 1).Select
Do While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = Trim(Me.Texthakno.Value) Then
If MsgBox(Me.Texthakno & " BU HAKEDİÞ NO BULUNMAKTADIR" & " Yeniden kayıt yapılsın mı?", vbYesNo) = vbNo Then Exit Sub
End If
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Value = Texthakno.Value
ActiveCell.Offset(0, 1).Value = Textyüklenici.Value
'MsgBox "KAYIT YAPILDI"
ActiveWorkbook.saveas Filename:="C:\hakprg\hakprgan\" & [d1].Value
Workbooks.Open Filename:="C:\hakprg\hakprgan\" & [d1].Value
Sheets("AÇ.ANA").Select
Range("E31") = Replace(ThisWorkbook.Name, ".xls", Empty)
'Workbooks("hak_prg1g.xls").Close (Bu kapanmasını istediğim ilk program)
Unload Me
End Sub

BU KOD İLE DOSYA İSMİNİ LİSTBOX DAN TEKSBOX’A ALIP SAYFADA AYIRIP DİÐER TEKSBOXDAKİ VERİ İLE BİRLEÞTİREREK KLOSERDEKİ MEVCUT DOSYAYI YENİ İSİMLE KAYDEDİYORUM.
Private Sub CommandButton4_Click()
Sheets("kayıt").Visible = True
Sheets("kayıt").Select
Range("L1").Value = TextBox2.Text
Range("K1").Value = TextBox1.Text
Range("N1").Value = ListBox1.Text

Sheets("kayıt").Select
Set ds = CreateObject("Scripting.FileSystemObject")
dosya = ds.GetFileName(TextBox2.Value)

kyds = [M9].Value
hdf = [L3].Value
FileCopy kyds, hdf
On Error GoTo gec
Windows("hak_prg1g.xls").Activate
If ActiveWindow.Caption = "hak_prg1g.xls" Then GoTo geciniz
geciniz:
Windows("hak_prg1g.xls").Close
gec:
Sheets("AÇ.ANA").Select
Unload Me
'ActiveWindow.SelectedSheets.Visible = False
' Sheets("kayıt").Visible = True

'ActiveWindow.SelectedSheets.Visible = False
Run "auto_open"
End Sub

 

[Levent Menteşoğlu]

İkinci kodu aşağıdaki gibi deneyin.

[vb:1:17febab84b]Private Sub CommandButton4_Click()
Sheets("kayıt").Visible = True
Sheets("kayıt").Select
Range("L1").Value = TextBox2.Text
Range("K1").Value = TextBox1.Text
Range("N1").Value = ListBox1.Text

Sheets("kayıt").Select
Set ds = CreateObject("Scripting.FileSystemObject")
dosya = ds.GetFileName(TextBox2.Value)

kyds = [M9].Value
hdf = [L3].Value
FileCopy kyds, hdf
On Error GoTo gec
Windows("hak_prg1g.xls").Close
Exit Sub
gec:
Sheets("AÇ.ANA").Select
Unload Me
End Sub
[/vb:1:17febab84b]

 

[GKMER]

AÞAÐIDAKİ KOT İLE Anahtar_Teslim dosyası kapanarak listbox1 den tıkladığım dosya açılıyor. Ama Anahtar_Teslim dosyası sadece form olarak açılıyor .
Anahtar_Teslim dosyasının formun açılışını Hakgir dosyasındaki makro ile çalıştırdığım Anahtar_Teslim dosyasınını autoopen’ı ile yapıyorum.
Burada yapmak istediğim hakgir dosyasında açtığımda çıkan form ile 2 ayrı Excel dosyasından birini açmak fakat bu dosyalar sadece kopya almak üzere kullanılıp kapatılması ve kopya ile oluşturulan dosyalar üzerinde çalışmak.
Üzerinde çalışılacak dosyalar açılıyor. Ana dosyalardan biri olan Anahtar_Teslim kapanıyor fakat giriş dosyası olan Hakgir dosyasını kapatamıyorum.
Biraz uzun oldu ama anlatabildiğimi düşünüyorum.

Private Sub CommandButton1_Click()
Application.Visible = True
On Error GoTo hata
Dim yol As String
Dim dosyaadi As String
yol = "C:\hakprg\hakprgan\"
dosyaadi = ListBox1.Value
Workbooks.Open ListBox1.Value
Application.DisplayAlerts = False
Workbooks("Anahtar_Teslim.xls").Close
Workbooks("hakgir.xls").Close
'(yol & dosyaadi), Password:="kilim", writerespassword:="kilim"
hata:
Unload Me
End Sub