"xxx adlı dosyanız bulunamadı" uyarısı verdirmek.

[Mahmut Kök]

Farklı elemanların aldığı siparişleri, TOPLU.xls adlı belgede bir araya getiriyoruz. Bunların değerlendirmelerini de SONUÇ11.xls, SONUÇ12.xls (...gibi) adlı belgeye aktarıyoruz.

Makro en başta, alınacak ve aktarılacak dosyaların adını soruyor ve bilgi alışverişlerini bu belgelerle yapıyor; ama bazen adını girdiğimiz dosya açık olmuyor veya dosya adını yanlış girmiş oluyoruz, bu durumda, o dosya açık olmadığı için, makro hata veriyor.

on error.. gibi bir mantık işimi görüyor, ama ben, hata hangi dosyadan kaynaklanıyorsa, o dosyanın adını vererek, "xxx adlı dosya bulunamadı" iletisini almak istiyorum. Yani, en başta girdiğimiz 2 dosyadan hangisini bulamamış, onu göstermesini istiyorum. Ben on error .. mantığıyla işimi halledemedim..

Yardımlarınız için şimdiden teşekkürler

 

[alpi]

Aşağıdaki kodlar işinizi görür umarım

Function DosyaAçıkmı(DosyaAdı1 As String, DosyaAdı2 As String) As Boolean
Dim say As Byte
Dim bak As Byte
Dim Dosya1Açık As Boolean
Dim Dosya2Açık As Boolean
say = Workbooks.Count
For bak = 1 To say
If Workbooks(bak).Name = DosyaAdı1 Then
DosyaAçıkmı = True
Dosya1Açık = True
End If
If Workbooks(bak).Name = DosyaAdı2 Then
DosyaAçıkmı = True
Dosya2Açık = True
End If
Next
If Not Dosya1Açık Then
MsgBox DosyaAdı1 & " adlı dosya açık değil."
DosyaAçıkmı = False
ElseIf Not Dosya2Açık Then
MsgBox DosyaAdı2 & " adlı dosya açık değil."
DosyaAçıkmı = False
End If
End Function
Sub Kullanımı()
'Dosyaların açık olup olmadığını aşağıdaki şekilde yazarak kontrol edebilirsiniz.
If DosyaAçıkmı("dosyaadı1.xls", "dosyaadı2.xls") = False Then Exit Sub
End Sub

 

[Levent Menteşoğlu]

Bu işlem için kendi kodlarınızı verirmisiniz.

 

[Mahmut Kök]

maalesef çalışmadı. Yani, dosya açıkken de "dosyaadı1.xls" adlı dosya açık değil diyor.

(Kodlarınıza özellikle müdahale etmedim ve kendime dosyaadı1 ve dosyaadı2 adlı 2 tane excel belgelesi oluşturdum.)

kendi kodlarımı gönderiyorum.

 

[Mahmut Kök]

kodlar (bilgi:Userformda kaynakdosya adlı textbox; bilgi de userformda bilgidosya adl

Sub TAŞIAKTAR()
'
' TAŞI Makro
' Makro buğra tarafından 29.04.2006 tarihinde kaydedildi.
'
Dim syf111, stro, strb, ktp, kimo, kimb, baslao, baslab, snfkodo, snfkodb

kaynak = testci1.kaynakdosya
bilgi = testci1.bilgidosya

'''''''''''''''''''''''''''''
Windows(kaynak).Activate
'
Sheets("Sayfa2").Select
stro = Range("A1").Value + 3


''************************************
For baslao = 4 To stro
Windows(kaynak).Activate
snfkodo = Cells(baslao, 11).Value
kimo = Cells(baslao, 6).Value

Windows(bilgi).Activate

For syf111 = 1 To 40
Sheets(syf111).Select
snfkodb = Range("E1").Value
If snfkodo = snfkodb Then GoTo 3

Next syf111
GoTo 9
3

strb = Range("A1").Value + 3
For baslab = 4 To strb

kimb = Cells(baslab, 6).Value

If kimo = kimb Then GoTo 5
Next baslab

'eğer listede adı yoksa satırın en altına ekleyen makro

Cells(baslab, 2).Select
Windows(kaynak).Activate

Range((Cells(baslao, 6)), (Cells(baslao, 112))).Select
Selection.Copy

Windows(bilgi).Activate

Sheets(syf111).Select
Cells(baslab, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'kodlarısil hemen
Range((Cells(baslab, 10)), (Cells(baslab, 11))).Select
Selection.ClearContents


Windows(kaynak).Activate

Range((Cells(baslao, 1)), (Cells(baslao, 112))).Select
Selection.Font.ColorIndex = 4

Windows(bilgi).Activate
Sheets(syf111).Select
Cells(baslab, 2).Select

Range((Cells(baslab - 1, 2)), (Cells(baslab, 5))).Select
Selection.Copy

Cells(baslab, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

GoTo 9
5

Windows(kaynak).Activate

Sheets("Sayfa2").Select

Range((Cells(baslao, 8)), (Cells(baslao, 112))).Select
Selection.Copy

Windows(bilgi).Activate

Sheets(syf111).Select
Cells(baslab, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range((Cells(baslab, 10)), (Cells(baslab, 11))).Select
Selection.ClearContents

Windows(kaynak).Activate
Range((Cells(baslao, 1)), (Cells(baslao, 112))).Select
Selection.Font.ColorIndex = 3

9
Next baslao

'''''''''''''

Windows("TEST").Activate

End Sub

 

[alpi]

Sayın mesleki aşağıdaki kod satırını kendinize uyarlamalısınız

If DosyaAçıkmı("dosyaadı1.xls", "dosyaadı2.xls") = False Then Exit Sub

buradaki dosyaadı1.xls ve dosyaadı2.xls sizin dosyalarınızın adını temsil ediyor. eğer dosya adları textboxz da ise şu şekilde değiştirmelisiniz

If DosyaAçıkmı(textbox1.text &".xls",textbox1.text & ".xls") = False Then Exit Sub

sadece bu satırı kendinize uyarlarsanız fonksiyon görevini yerine getirecektir.