Hata Mesajı Hk.

[petsiye]

Merhaba ,

Elimde aşağıdaki gibi bir kod var. VBA' dan anlayanlar için, koddan da anlaşılacağı üzere, masaüstünde açık halde " Temp.xls" isimli bir dosya varsa o dosyayı, bendeki excel dosyasına yapıştırıp, " Temp.xls" dosyasını benden onay almadan kapatıyor.

Benim rica şudur ; Aşağıdaki macro kodları çalıştırıldığında, eğer masaüstünde açık halde " Temp.xls " dosyası yok ise, " Dosya bulunamadı" şeklinde bir hata/uyarı mesajı vermesini nasıl sağlayabilirim.

Cevaplarınız için şimdiden teşekkür ederim.



Elimdeki Kod :

Sub TEST()
'
' TEST Makro
'

'
Sheets("YATIRIM DEĞERLENDİRME").Select
Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Visible = True

Windows("Temp.xls").Activate
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("PROJE.xlsb").Activate
Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("YATIRIM DEĞERLENDİRME").Select
Range("B2").Select
Windows("Temp.xls").Activate
Application.CutCopyMode = False
ActiveWindow.Close
ActiveSheet.Range("$B$2:$AA$10647").AutoFilter Field:=1, Criteria1:= _
"<>*UP*", Operator:=xlAnd, Criteria2:="<>*DOWN*"
Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Select
ActiveWindow.SelectedSheets.Visible = False
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

End Sub

 

[klop01]

petsiye,
Deneyiniz.

Sub TEST()
    On Error Resume Next
    Dim tempFile As Workbook
    Set tempFile = Workbooks("Temp.xls")
    If tempFile Is Nothing Then
        MsgBox "Temp.xls dosyası bulunamadı."
        Exit Sub
    End If
    Sheets("YATIRIM DEĞERLENDİRME").Select
    Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Visible = True
    tempFile.Activate
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("PROJE.xlsb").Activate
    Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("YATIRIM DEĞERLENDİRME").Select
    Range("B2").Select
    tempFile.Close SaveChanges:=False
    ActiveSheet.Range("$B$2:$AA$10647").AutoFilter Field:=1, Criteria1:= _
        "<>*UP*", Operator:=xlAnd, Criteria2:="<>*DOWN*"
    Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Select
    ActiveWindow.SelectedSheets.Visible = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
End Sub

 

[petsiye]

Sayın klop01,

Nokta atışı cevabınız için çok teşekkür ederim. Fakat aşağıdaki şekilde bir soru mesajı almaktayım. Hem bu soruyu direkt " Hayır " olarak cevaplayıp, hemde " Temp.xls " dosyasının sorgusuz sualsiz kapatılmasını nasıl sağlayabilirim acaba ?



iyi çalışmalar dilerim

 

[klop01]

Sub TEST()
    On Error Resume Next
    Dim tempFile As Workbook
    Set tempFile = Workbooks("Temp.xls")
    If tempFile Is Nothing Then
        MsgBox "Temp.xls dosyası bulunamadı."
        Exit Sub
    End If
    Application.DisplayAlerts = False
    Sheets("YATIRIM DEĞERLENDİRME").Select
    Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Visible = True
    tempFile.Activate
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("PROJE.xlsb").Activate
    Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("YATIRIM DEĞERLENDİRME").Select
    Range("B2").Select
    tempFile.Close SaveChanges:=False
    Application.DisplayAlerts = True
    ActiveSheet.Range("$B$2:$AA$10647").AutoFilter Field:=1, Criteria1:= _
        "<>*UP*", Operator:=xlAnd, Criteria2:="<>*DOWN*"
    Sheets("TARAMA SONUCUNU BURAYA YAPIŞTIR").Select
    ActiveWindow.SelectedSheets.Visible = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    Workbooks("Temp.xls").Close SaveChanges:=False
End Sub

 

[petsiye]

Verdiğiniz kod sorunsuz ve sorusuz gayet güzel çalışıyor.

Tekrar çok teşekkür eder, İyi çalışmalar dilerim