Başka bilgisayarda application-defined or object-defined error hatası

mbugra · 31 Mart 2021

Herkese iyi günler iyi çalışmalar;

İlk yorumda göndereceğim makro kodunda şu şekilde
( Run-time error ‘1004’:
application-defined or object-defined error)

hata almaktayım. Daha doğrusu kod ana bilgisayarda sorunsuz çalışıyor, Başka bilgisayarda bu hatayı veriyor.

Makro Kodunun; bu satırında

If Picture.TopLeftCell.Row >= 1 And Picture.TopLeftCell.Row <= 4 Then
Picture.Delete

Bu sorunu nasıl çözebilirim başka bilgisayarlarda bu sorunla karşılaşmamak İçin. Şimdiden teşekkür ederim...

Sub Dosyayi_Makrosuz_Formulsuz_Farkli_Kaydet()
Dim Aktif_Dosya As Workbook, Sayfa As Worksheet, Yeni_Dosya As Workbook

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
End With

Set Aktif_Dosya = ThisWorkbook

For Each Sayfa In Aktif_Dosya.Worksheets
Sayfa.Unprotect "12345"
Next

Aktif_Dosya.Sheets.Copy

Set Yeni_Dosya = ActiveWorkbook

For Each Sayfa In Yeni_Dosya.Worksheets
With Sayfa
.Select
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells.Replace 0, "", xlWhole

Dim Picture As Object
For Each Picture In ActiveSheet.Shapes

If Picture.TopLeftCell.Row >= 1 And Picture.TopLeftCell.Row <= 4 Then
Picture.Delete

End If
Next Picture

.Range("A1").Select

End With
Next

Sheets(1).Select

Yeni_Dosya.Sheets(Array("İSİM VERİ GİRİŞ", "FAALİYET TOPLAM", "KGİRİŞ", "KANALİZ", "CEKRANI", "SGİRİŞ", "GÜGİRİŞ", "LİSTE", "DOĞRULAMA", "ANA SAYFA FİHRİST")).Delete

Yeni_Dosya.SaveAs Aktif_Dosya.Path & Application.PathSeparator & CreateObject("Scripting.FileSystemObject").GetBaseName(Aktif_Dosya.Name), 51

Yeni_Dosya.Close

For Each Sayfa In Aktif_Dosya.Worksheets
Sayfa.Protect "12345"
Next

Set Yeni_Dosya = Nothing
Set Aktif_Dosya = Nothing

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
End With

MsgBox "İşlem Tamamlanmış, İşlemi Yaptığınız Yere Formülsüz Olarak Kopyalanmıştır...", vbInformation
End Sub
[/CODE]

mbugra · 31 Mart 2021

Kod:

Sub Dosyayi_Makrosuz_Formulsuz_Farkli_Kaydet()
    Dim Aktif_Dosya As Workbook, Sayfa As Worksheet, Yeni_Dosya As Workbook
  
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
  
    Set Aktif_Dosya = ThisWorkbook
  
    For Each Sayfa In Aktif_Dosya.Worksheets
        Sayfa.Unprotect "12345"
    Next

    Aktif_Dosya.Sheets.Copy
  
    Set Yeni_Dosya = ActiveWorkbook

    For Each Sayfa In Yeni_Dosya.Worksheets
        With Sayfa
            .Select
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells.Replace 0, "", xlWhole
          
          
Dim Picture As Object
For Each Picture In ActiveSheet.Shapes

If Picture.TopLeftCell.Row >= 1 And Picture.TopLeftCell.Row <= 4 Then
Picture.Delete

End If
Next Picture
          
            .Range("A1").Select
          
        End With
    Next
  
    Sheets(1).Select
  
    Yeni_Dosya.Sheets(Array("İSİM VERİ GİRİŞ", "FAALİYET TOPLAM", "KGİRİŞ", "KANALİZ", "CEKRANI", "SGİRİŞ", "GÜGİRİŞ", "LİSTE", "DOĞRULAMA", "ANA SAYFA FİHRİST")).Delete
  
    Yeni_Dosya.SaveAs Aktif_Dosya.Path & Application.PathSeparator & CreateObject("Scripting.FileSystemObject").GetBaseName(Aktif_Dosya.Name), 51
  
    Yeni_Dosya.Close
  
    For Each Sayfa In Aktif_Dosya.Worksheets
        Sayfa.Protect "12345"
    Next
  
    Set Yeni_Dosya = Nothing
    Set Aktif_Dosya = Nothing
  
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With

    MsgBox "İşlem Tamamlanmış, İşlemi Yaptığınız Yere Formülsüz Olarak Kopyalanmıştır...", vbInformation
End Sub

Korhan Ayhan · 31 Mart 2021

Merhaba,

Denemedim ama ek bilgi olarak hatırlatma istediğim bir durum var.

Kullandığınız değişken isimlerini VBA tarafında kullanılan ifadelerin dışında belirlemek daha doğru olacaktır.

"Picture" ifadesi VBA tarafında kullanılan bir terimdir. Bu sebeple değiştirip kodu öyle denemenizi tavsiye ederim.

Örneğin aşağıdaki gibi tanımlayıp kod içinde kullanabilirsiniz.

Dim Resim As Object

mbugra · 31 Mart 2021

Korhan Ayhan' Alıntı:
Merhaba,

Denemedim ama ek bilgi olarak hatırlatma istediğim bir durum var.

Kullandığınız değişken isimlerini VBA tarafında kullanılan ifadelerin dışında belirlemek daha doğru olacaktır.

"Picture" ifadesi VBA tarafında kullanılan bir terimdir. Bu sebeple değiştirip kodu öyle denemenizi tavsiye ederim.

Örneğin aşağıdaki gibi tanımlayıp kod içinde kullanabilirsiniz.

Dim Resim As Object

Korhan Hocam öncelikle teşekkür ederim,

Makro bilgim çok zayıf öğrenmeye çalışıyorum, tanımlamayı anlayamadım. Aslında çalışma kitabı içerisinde resimden kasıt, (Metin Kutusu, hazır şekil var fotoğraf v.b. yok).

Bu formülü sizden alarak kendime göre düzenledim, çokta işime yaradı ve sorunsuz olarakta bilgisayarımda çalıştı, ancak farklı bilgisayarlara gönderdiğimde onlarda bu hatayı verdi.

Makronun bu bölümünü nasıl düzenlemeliyim,

1 ve 4 satır aralığındaki tüm şekilleri nasıl silerek yeni sayfaya kaydederim. Yardımcı olabilirseniz sevinirim iyi çalışmalar...

mbugra · 31 Mart 2021

Bu şekilde düzenledim ancak yine
( Run-time error ‘1004’:
application-defined or object-defined error) hatasını aynı satırda aldım

Dim Shapes As Object
For Each Shapes In ActiveSheet.Shapes

If Shapes.TopLeftCell.Row >= 1 And Shapes.TopLeftCell.Row <= 4 Then
Shapes.Delete

End If
Next Shapes

.Range("A1").Select

End With
Next

Korhan Ayhan · 31 Mart 2021

Bir bilgisayarda çalışıyorsa kod sorunsuz demektir. Bilgisayarda başka bir sorun vardır.

Korhan Ayhan · 31 Mart 2021

Dim Nesne As Object olarak deneyiniz.

mbugra · 31 Mart 2021

Bu şekilde denedim yine aynı yerde kırmızı satırda hata verdi,

Dim sekiL As Shape

For Each sekiL In ActiveSheet.Shapes
If Not Intersect(sekiL.TopLeftCell, Range("A1:BA4")) Is Nothing Then
sekiL.Delete

End If
Next sekiL

.Range("A1").Select

End With

Korhan Ayhan · 31 Mart 2021

Örnek dosyanızı paylaşın biz de deneyelim.

mbugra · 31 Mart 2021

Korhan Ayhan' Alıntı:
Dim Nesne As Object olarak deneyiniz.

Korhan Hocam bu şekil dediğiniz gibi denedim yine aynı satır hata veriyor doğru yazdım mı emin değilim ama...

Hocam Bilgisayarda nasıl bir sorun olabilir onu nasıl çözebilirim...

Dim Nesne As Object

For Each Nesne In ActiveSheet.Shapes
If Not Intersect(Nesne.TopLeftCell, Range("A1:BA4")) Is Nothing Then
Nesne.Delete

End If
Next Nesne

.Range("A1").Select

End With

mbugra · 31 Mart 2021

Korhan Ayhan' Alıntı:
Örnek dosyanızı paylaşın biz de deneyelim.

Hocam dosyayı ekledim

Orion1 · 31 Mart 2021

Tahminimce bir nesne yok.
Çalışan bilgiyarda varda diğer bilgisayarda yoksa o sebepten verir.
Genellikle listview veya calendar ekli ise yapar.
VBE de Tools==>Reference ye Bakın.Orada MISSING deyimi varsa yukarıda yazdıklarım yüzündendir.
Excel 64 bit ise 32 bitte olan nesne 64 bitte de çalışmaz.

Korhan Ayhan · 31 Mart 2021

Aşağıdaki şekilde bende sorunsuz çalıştı.

C++:

Option Explicit

Sub Dosyayi_Makrosuz_Formulsuz_Farkli_Kaydet()
    Dim Aktif_Dosya As Workbook, Sayfa As Worksheet, Yeni_Dosya As Workbook, Nesne As Object

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    Set Aktif_Dosya = ThisWorkbook
    
    For Each Sayfa In Aktif_Dosya.Worksheets
        Sayfa.Unprotect "12345"
    Next

    Aktif_Dosya.Sheets.Copy
    
    Set Yeni_Dosya = ActiveWorkbook

    For Each Sayfa In Yeni_Dosya.Worksheets
        With Sayfa
            .Select
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells.Replace 0, "", xlWhole
            
            For Each Nesne In .Shapes
                If Nesne.TopLeftCell.Row >= 1 And Nesne.TopLeftCell.Row <= 4 Then
                    Nesne.Delete
                End If
            Next
            
            .Range("A1").Select
        End With
    Next
    
    Sheets(1).Select
    
    Yeni_Dosya.Sheets(Array("Sayfa1", "Sayfa2", "Sayfa3")).Delete
    
    Yeni_Dosya.SaveAs Aktif_Dosya.Path & Application.PathSeparator & CreateObject("Scripting.FileSystemObject").GetBaseName(Aktif_Dosya.Name), 51
    
    Yeni_Dosya.Close
    
    For Each Sayfa In Aktif_Dosya.Worksheets
        Sayfa.Protect "12345"
    Next
    
    Set Yeni_Dosya = Nothing
    Set Aktif_Dosya = Nothing
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With

    MsgBox "İşlem tamamlanmış, işlemi yaptığınız yere formülsüz olarak kopyalanmıştır...", vbInformation
End Sub

mbugra · 31 Mart 2021

Korhan Ayhan' Alıntı:

Aşağıdaki şekilde bende sorunsuz çalıştı.

C++:

Option Explicit

Sub Dosyayi_Makrosuz_Formulsuz_Farkli_Kaydet()
    Dim Aktif_Dosya As Workbook, Sayfa As Worksheet, Yeni_Dosya As Workbook, Nesne As Object

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
   
    Set Aktif_Dosya = ThisWorkbook
   
    For Each Sayfa In Aktif_Dosya.Worksheets
        Sayfa.Unprotect "12345"
    Next

    Aktif_Dosya.Sheets.Copy
   
    Set Yeni_Dosya = ActiveWorkbook

    For Each Sayfa In Yeni_Dosya.Worksheets
        With Sayfa
            .Select
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells.Replace 0, "", xlWhole
           
            For Each Nesne In .Shapes
                If Nesne.TopLeftCell.Row >= 1 And Nesne.TopLeftCell.Row <= 4 Then
                    Nesne.Delete
                End If
            Next
           
            .Range("A1").Select
        End With
    Next
   
    Sheets(1).Select
   
    Yeni_Dosya.Sheets(Array("Sayfa1", "Sayfa2", "Sayfa3")).Delete
   
    Yeni_Dosya.SaveAs Aktif_Dosya.Path & Application.PathSeparator & CreateObject("Scripting.FileSystemObject").GetBaseName(Aktif_Dosya.Name), 51
   
    Yeni_Dosya.Close
   
    For Each Sayfa In Aktif_Dosya.Worksheets
        Sayfa.Protect "12345"
    Next
   
    Set Yeni_Dosya = Nothing
    Set Aktif_Dosya = Nothing
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With

    MsgBox "İşlem tamamlanmış, işlemi yaptığınız yere formülsüz olarak kopyalanmıştır...", vbInformation
End Sub

Korhan Hocam çok teşekkür ederim ilginiz için sizdede oluyorsa Bilgisayarda sorun var o zaman onu çözmeye çalışacağız. Nesne olarakta düzenlediğiniz için ayrıca teşekkür ederim.

mbugra · 31 Mart 2021

Orion1' Alıntı:
Tahminimce bir nesne yok.
Çalışan bilgiyarda varda diğer bilgisayarda yoksa o sebepten verir.
Genellikle listview veya calendar ekli ise yapar.
VBE de Tools==>Reference ye Bakın.Orada MISSING deyimi varsa yukarıda yazdıklarım yüzündendir.
Excel 64 bit ise 32 bitte olan nesne 64 bitte de çalışmaz.

Hocam teşekkür ederim kontrol ettim MISSING deyimi yok başka ne yapabilirim bu sorunu çözmek için,

Korhan Hocam kodlarda sorun olmadığını söyledi demekki başka sorun var bilgisayar ile ilgili..:

Korhan Ayhan · 31 Mart 2021

Hata aldığınız PC'nin işletim sistemi, ofis sürümü nedir?

mbugra · 31 Mart 2021

Korhan Ayhan' Alıntı:
Hata aldığınız PC'nin işletim sistemi, ofis sürümü nedir?

Korhan Hocam işyerinde yarın baktırmam lazım, yarın buraya yazarım

mbugra · 1 Nisan 2021

Korhan Ayhan' Alıntı:
Hata aldığınız PC'nin işletim sistemi, ofis sürümü nedir?

Korhan Hocam Windows 10, İ5, Excel 2016
Akşama kadar uğraştım yine olmadı, aynı hatayı veriyor, işin ilginç tarafı aynı makro aynı bilgisayarda başka biraz değişik çalışma kitabım var onda da aynı nesneler var sadece sayfa sayısı biraz düşük onda saat gibi çalışıyor.
Ne yapsam olmadı

Korhan Ayhan · 1 Nisan 2021

Emin değilim ama Ram sorunu olabilir mi?

mbugra · 1 Nisan 2021

Korhan Ayhan' Alıntı:
Emin değilim ama Ram sorunu olabilir mi?

Korhan Hocam, evdeki PC de çalışmayı tamamlayıp CD ortamına aldıktan sonra iş yerindeki PC’ ye yükledim, evdekinde RAM sorunu olabilir ancak; diğer çalışma kitabınıda aynı yerden aldım onda problem olmadı...

Makroyu sildim yeniden yazdım yine olmadı, sorunlu bölümü tekrar sildim yine yazdın yine olmadı, İf ile başlayan nesne satırı hep hata verdi.

Diyelim ki! RAM veya başka bir sorun nasıl bu sorunu çözmeliyim yol bulamadım, dosya bozulmuş olabilir mi, bozuksa yaklaşık 40 sayfa var bunu sil baştan yapmak çok zaman alır...

Başka bilgisayarda application-defined or object-defined error hatası

mbugra

mbugra

Korhan Ayhan

Administrator

mbugra

mbugra

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

mbugra

Korhan Ayhan

Administrator

mbugra

mbugra

Ekli dosyalar

Orion1

Uzman

Korhan Ayhan

Administrator

mbugra

mbugra

Korhan Ayhan

Administrator

mbugra

mbugra

Korhan Ayhan

Administrator

mbugra