Başka dosyadan veri alma hata

[magnet2014]

Arkadaşlar merhaba,

Aşağıdaki kod ile çalışan bir macrom var. Ana dosya da ilgili hücreye veri alınacak excel çalışma kitabının ismi yazıldığı zaman, o çalışma kitabındaki verileri çekerek karşılaştırıyordu ve sorunsuz çalışmaktaydı. Tek şart veri alınan dosyanın da açık olmasıydı. Ancak bilgisayarıma format atıldıktan sonra veri alınacak dosya açık olmasına rağmen " ........,Dosyası açık degil" uyarısı çıkıyor ve işlem yapmıyor.

Şirket özel bilgilerini içerdiği için dosyayı paylaşamıyorum. Macro'ya bakıp yorum yapabilecek arkadaşlardan yardımcı olmalarını rica ediyorum. Çok teşekkür ederim

Dim DisDosyaIsmi As String
Dim BuDosyaAdi As String
Dim BosSatir As Integer
Dim SheetIsmi As String

Private Sub Parametreler()
    DisDosyaIsmi = Cells(3, 10)
    If Trim(DisDosyaIsmi) = "" Then
        MsgBox "Veri alınacak dosya ismi girilmedi!!!"
        End
    End If
    BuDosyaAdi = ActiveWorkbook.Name
    Range("a1:a3000").Select: Selection.ClearContents
    SheetIsmi = "VIS"
End Sub
Private Function Cevir(ByVal Rakkam As String) As String
Dim Boy As Integer
Dim Sonuc As String

Boy = Len(Rakkam)
    For i = 1 To Boy
        If Mid(Rakkam, i, 1) = "," Then
            Cevir = Cevir & "."
        Else
            If Mid(Rakkam, i, 1) <> "," Then
                Cevir = Cevir & Mid(Rakkam, i, 1)
            End If
        End If
    Next i
End Function
Private Function Dolanim(pDepo As String, pUrun As String, pGun As String, pIskonto As String) As String
On Error GoTo ErrorMng
    Dim BosSat2 As Integer
    Dim Sat2 As Integer
    Dim MyCheck
    BosSat2 = 0: Sat2 = 1
    Windows(DisDosyaIsmi).Activate
    Sheets(SheetIsmi).Select
    
    Do While True
        If Trim(Cells(Sat2, 2)) = "" Then
            BosSat2 = BosSat2 + 1
            If BosSat2 > 100 Then
                Dolanim = "Hata"
                Exit Do
            End If
        Else
            BosSat2 = 0
            If Cells(Sat2, 2) = pDepo And Cells(Sat2, 3) = pUrun Then
                Cells(Sat2, 18) = pGun
                Cells(Sat2, 24) = pIskonto
               
                Dolanim = Cevir(Round(Cells(Sat2, 35), 2))
                Exit Do
            End If
        End If
        Sat2 = Sat2 + 1
    Loop
  Windows(BuDosyaAdi).Activate
Exit Function

ErrorMng:
MsgBox DisDosyaIsmi & " ,Dosyası açık degil..."
End
End Function
Private Sub IslemeBasla()
    Dim Sat As Integer
    Dim DonenDeger As String
    BosSatir = 0: Sat = 5
    Do While True
'===================================================================================================
        If Trim(Cells(Sat, 3)) = "" Then
            BosSatir = BosSatir + 1
            If BosSatir > 10 Then Exit Do
        Else
            BosSatir = 0
            If (Trim(Cells(Sat, 3)) = "") Or (Trim(Cells(Sat, 4)) = "") Then
                Cells(Sat, 1) = "Hata"
            Else
                DonenDeger = Dolanim(Cells(Sat, 3), Cells(Sat, 4), Cells(Sat, 5), Cells(Sat, 6))
                If DonenDeger = "Hata" Then
                    Cells(Sat, 1) = "Hata"
                Else
                    Cells(Sat, 7) = DonenDeger
                    Cells(Sat, 1) = ""
                End If
            End If
        End If
'===================================================================================================
        Sat = Sat + 1
    Loop
End Sub
Public Sub XBasla()
    Call Parametreler
    Call IslemeBasla
End Sub

 

[Muzaffer Ali]

Aşağıdaki kodlarda yapılan hesaplamalarda bir hata oluyor.
Hata olduğu için, "On Error GoTo ErrorMng" kod satırı ile hata kontrolü yapıyor. Eğer herhangi bir hata ile karşılaşılırsa belirtilen mesaj kutusu çıkıyor.

Hatanın ne olduğunu daha iyi anlayabilmek için

On Error GoTo ErrorMng

satırını silin. Kodları çalıştırın, şimdi aldığınız hatanın ne olduğunu yazın, belki bir çözüm bulabiliriz.

Private Function Dolanim(pDepo As String, pUrun As String, pGun As String, pIskonto As String) As String
On Error GoTo ErrorMng
    Dim BosSat2 As Integer
    Dim Sat2 As Integer
    Dim MyCheck
    BosSat2 = 0: Sat2 = 1
    Windows(DisDosyaIsmi).Activate
    Sheets(SheetIsmi).Select
    
    Do While True
        If Trim(Cells(Sat2, 2)) = "" Then
            BosSat2 = BosSat2 + 1
            If BosSat2 > 100 Then
                Dolanim = "Hata"
                Exit Do
            End If
        Else
            BosSat2 = 0
            If Cells(Sat2, 2) = pDepo And Cells(Sat2, 3) = pUrun Then
                Cells(Sat2, 18) = pGun
                Cells(Sat2, 24) = pIskonto
               
                Dolanim = Cevir(Round(Cells(Sat2, 35), 2))
                Exit Do
            End If
        End If
        Sat2 = Sat2 + 1
    Loop
  Windows(BuDosyaAdi).Activate
Exit Function

ErrorMng:
MsgBox DisDosyaIsmi & " ,Dosyası açık degil..."
End
End Function