Farklı Kaydet Sorunu!

M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
Merhaba Arkadaşlar;
aşağıda kopyaladığım kod dizininde bir hata var. çok uğraştım ama nedenini bulamadım. kod dizini bazı bilgisayarlarda çalışıp bazılarında çalışmıyor. kodda bir hata mı var? yardımcı olabilir misiniz?
Teşekkürler


Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
deger = Format(i, "yyyymmdd") & "-" & Sheets("sayfa1").Range("c10").Value
On Error Resume Next
kaynak = "c:" & "\Verilen Teklifler"
If Dir(kaynak) = "" Then MkDir (kaynak)
On Error Resume Next
If Worksheets("sayfa1").Range("B14") = "" Then
MsgBox "Kayıt Yapılacak Veri Bulunamadı.", vbInformation, " BİLGİ"
Else
Sheets(Array("sayfa1", "sayfa2")).Copy
For Each component In ActiveWorkbook.VBProject.VBComponents
If component.Type <> 100 Then
ActiveWorkbook.VBProject.VBComponents.Remove component
Else
Set modul = component.CodeModule
modul.DeleteLines 1, modul.CountOfLines
End If
Next
ActiveSheet.DrawingObjects.Delete
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs kaynak & "\" & deger & ".xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close False

MsgBox "" & Worksheets("sayfa1").Range("C10").Value & "" & vbLf & kaynak & vbLf & "Klasörüne kayıt Yapıldı.", vbInformation, " BİLGİ"
End If
'End If
'Next sayfa
Sheets("sayfa1").Range("B14:K100").ClearContents
Sheets("sayfa1").Range("C10").ClearContents
Application.ScreenUpdating = True
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Vermiş olduğunuz kodda VB kodlarını silen kod satırları bulunuyor. Bu satırlarda hata alıyorsanız hata vere bilgisayarlarda aşağıdaki işlemi uygulamalısınız.

Boş bir excel kitabı açın.
ARAÇLAR-MAKRO-GÜVENLİK menüsünü açın.
GÜVENİLEN YAYIMCILAR sekmesini tıklayın.
Alt bölümdeki "Visual Basic Project erişimine güven" seçeneğini aktif hale getirin.
 
M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
Korhan Ayhan' Alıntı:
Selamlar,

Vermiş olduğunuz kodda VB kodlarını silen kod satırları bulunuyor. Bu satırlarda hata alıyorsanız hata vere bilgisayarlarda aşağıdaki işlemi uygulamalısınız.

Boş bir excel kitabı açın.
ARAÇLAR-MAKRO-GÜVENLİK menüsünü açın.
GÜVENİLEN YAYIMCILAR sekmesini tıklayın.
Alt bölümdeki "Visual Basic Project erişimine güven" seçeneğini aktif hale getirin.
Genişletmek için tıkla ...
Sayın Korhan Ayhan Üstadım;
aslına bakarsanız uğraşa uğraşa hata veren yerlerin bir çoğüunu hallettim. ancak date(format,"yyyymmdd") kısmında date'i hata olarak işaretliyor. ne yaptıysam olmadı. günün tarihini kaydedilecek dosyanın başına da koymam şart. bu kodu farklı yazabilir miyim?
teşekkürler.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Ben verdiğiniz ilk kodda "date..." ile başlayan bir satır göremiyorum. Lütfen örnek dosya eklermisiniz.
 
M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
Korhan Ayhan' Alıntı:
Selamlar,

Ben verdiğiniz ilk kodda "date..." ile başlayan bir satır göremiyorum. Lütfen örnek dosya eklermisiniz.
Genişletmek için tıkla ...
Sayın Korhan Bey;
örnek bir dosya ekledim. buradaki date kısmı benim bilgisayarımda çalışıyor. bir iki bilgisayarda daha çalıştı. ama çalışmayan hata veren bilgisyarlar da oldu. nedenini anlayamadım.
 

Ekli dosyalar

M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
hata olarak "can't find project or library" hatası veriyor
ama dediğim gibi her bilgisayarda değil bazılarında
 
mancubus

mancubus

Destek Ekibi
Destek Ekibi
Katılım
6 Ocak 2010
Mesajlar
2,224
Excel Vers. ve Dili
İŞ: 2021 Win Eng
çalışan bilgisayarda VBE'de tools/references'dan neler işaretli tespit edin, çalışmayan bilgisayarda da aynılarının işaretli olmasını sağlayın.
 
M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
mancubus' Alıntı:
çalışan bilgisayarda VBE'de tools/references'dan neler işaretli tespit edin, çalışmayan bilgisayarda da aynılarının işaretli olmasını sağlayın.
Genişletmek için tıkla ...
Sayın mancubus;
dediğiniz gibi referencestan missing ile başlayan onay kutusunu kaldırdığımda sorun çözüldü. peki daha kalıcı bir çözüm var mı? atıyorum 100 bilgisayarda bu çalışma kullanılacaksa hepsinde tek tek ayar yapmamız mümkün değil, bu tarih formatını hata verdirmeden başka türlü yazabilir miyiz?
teşekkürler...
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Birde aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim Deger As String, Component As Object, VBComponents As Object, Kaynak As String, Modul As Object
    
    Application.ScreenUpdating = False
    
    Kaynak = "C:\Verilen Teklifler"
    
    If Not CreateObject("Scripting.FileSystemObject").FolderExists(Kaynak) Then
        CreateObject("Scripting.FileSystemObject").CreateFolder (Kaynak)
    End If
    
    If Worksheets("Sayfa1").Range("B14") = "" Then
        MsgBox "Kayıt Yapılacak Veri Bulunamadı.", vbInformation, " BİLGİ"
    Else
        
        Sheets(Array("Sayfa1", "Sayfa2")).Copy
        
        For Each Component In ActiveWorkbook.VBProject.VBComponents
            If Component.Type <> 100 Then
                ActiveWorkbook.VBProject.VBComponents.Remove Component
            Else
                Set Modul = Component.CodeModule
                Modul.DeleteLines 1, Modul.CountOfLines
            End If
        Next
    
        ActiveSheet.DrawingObjects.Delete
        Application.DisplayAlerts = False
        
        Deger = Format(Date, "yyyymmdd") & "-" & Sheets("Sayfa1").Range("C10").Value
    
        ActiveWorkbook.SaveAs Filename:=Kaynak & "\" & Deger & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close False
        
        Sheets("Sayfa1").Range("B14:K100").ClearContents
        Sheets("Sayfa1").Range("C10").ClearContents
        
        MsgBox "" & Worksheets("Sayfa1").Range("C10").Value & "" & vbLf & Kaynak & vbLf & _
        "Klasörüne kayıt yapıldı.", vbInformation, "BİLGİ"
    End If
    
    Application.ScreenUpdating = True
End Sub
 
M

mbldn

Katılım
7 Mart 2011
Mesajlar
184
Excel Vers. ve Dili
2007 TR
Korhan Ayhan' Alıntı:
Selamlar,

Birde aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim Deger As String, Component As Object, VBComponents As Object, Kaynak As String, Modul As Object
    
    Application.ScreenUpdating = False
    
    Kaynak = "C:\Verilen Teklifler"
    
    If Not CreateObject("Scripting.FileSystemObject").FolderExists(Kaynak) Then
        CreateObject("Scripting.FileSystemObject").CreateFolder (Kaynak)
    End If
    
    If Worksheets("Sayfa1").Range("B14") = "" Then
        MsgBox "Kayıt Yapılacak Veri Bulunamadı.", vbInformation, " BİLGİ"
    Else
        
        Sheets(Array("Sayfa1", "Sayfa2")).Copy
        
        For Each Component In ActiveWorkbook.VBProject.VBComponents
            If Component.Type <> 100 Then
                ActiveWorkbook.VBProject.VBComponents.Remove Component
            Else
                Set Modul = Component.CodeModule
                Modul.DeleteLines 1, Modul.CountOfLines
            End If
        Next
    
        ActiveSheet.DrawingObjects.Delete
        Application.DisplayAlerts = False
        
        Deger = Format(Date, "yyyymmdd") & "-" & Sheets("Sayfa1").Range("C10").Value
    
        ActiveWorkbook.SaveAs Filename:=Kaynak & "\" & Deger & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close False
        
        Sheets("Sayfa1").Range("B14:K100").ClearContents
        Sheets("Sayfa1").Range("C10").ClearContents
        
        MsgBox "" & Worksheets("Sayfa1").Range("C10").Value & "" & vbLf & Kaynak & vbLf & _
        "Klasörüne kayıt yapıldı.", vbInformation, "BİLGİ"
    End If
    
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Korhan Bey;
elinize sağlık yine ustalığınızı konuşturdunuz. sorunsuz bir şekilde çalıştı
teşekkür ederim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Eğer yinede referans problemi yaşarsanız aşağıdaki koduda kullanabilirsiniz.

Kod: 
Option Explicit
 
Private Sub CommandButton1_Click()
    Dim Deger As String, Component As Object, VBComponents As Object, Kaynak As String, Modul As Object
    
    Application.ScreenUpdating = False
    
    References_RemoveMissing
    Kaynak = "C:\Verilen Teklifler"
    
    If Not CreateObject("Scripting.FileSystemObject").FolderExists(Kaynak) Then
        CreateObject("Scripting.FileSystemObject").CreateFolder (Kaynak)
    End If
    
    If Worksheets("Sayfa1").Range("B14") = "" Then
        MsgBox "Kayıt Yapılacak Veri Bulunamadı.", vbInformation, " BİLGİ"
    Else
        
        Sheets(Array("Sayfa1", "Sayfa2")).Copy
        
        For Each Component In ActiveWorkbook.VBProject.VBComponents
            If Component.Type <> 100 Then
                ActiveWorkbook.VBProject.VBComponents.Remove Component
            Else
                Set Modul = Component.CodeModule
                Modul.DeleteLines 1, Modul.CountOfLines
            End If
        Next
    
        ActiveSheet.DrawingObjects.Delete
        Application.DisplayAlerts = False
        
        Deger = Format(Date, "yyyymmdd") & "-" & Sheets("Sayfa1").Range("C10").Value
    
        ActiveWorkbook.SaveAs Filename:=Kaynak & "\" & Deger & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close False
        
        Sheets("Sayfa1").Range("B14:K100").ClearContents
        Sheets("Sayfa1").Range("C10").ClearContents
        
        MsgBox "" & Worksheets("Sayfa1").Range("C10").Value & "" & vbLf & Kaynak & vbLf & _
        "Klasörüne kayıt yapıldı.", vbInformation, "BİLGİ"
    End If
    
    Application.ScreenUpdating = True
End Sub
 
Sub References_RemoveMissing()
    Dim Referans As Variant, X As Long
     
    On Error Resume Next
     
    For X = ThisWorkbook.VBProject.References.Count To 1 Step -1
        Set Referans = ThisWorkbook.VBProject.References.Item(X)
        If Referans.IsBroken = True Then
            ThisWorkbook.VBProject.References.Remove Referans
        End If
    Next
     
    On Error GoTo 0
End Sub
 
Y

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
218
Excel Vers. ve Dili
Office Pro 2016 TR
Altın Üyelik Bitiş Tarihi
09-02-2028
Hocam ben de şöyle bir sorun alıyorum evimdeki pc de direk ilgili konumu kaydet yapıyor fakat kurumda ki bilgisayarda farklı kaydet çıkıyor

C++: 
' Yeni çalışma kitabı için dosya yolunu oluştur

    Dim filePath As String

    filePath = ThisWorkbook.Path & "\" & FolderName & ".xlsx"

    

    ' Eğer dosya yoksa yeni bir dosya oluştur, varsa dosyayı aç

    Dim newWb As Workbook

    If Dir(filePath) = "" Then

        Set newWb = Workbooks.Add(xlWBATWorksheet)

    Else

        Application.DisplayAlerts = False ' Uyarı mesajlarını kapat

        Set newWb = Workbooks.Open(filePath)

        newWb.Windows(1).Visible = True

        Application.DisplayAlerts = True ' Uyarı mesajlarını aç

    End If

    

    ' "Islem_Yapilan" adında bir sayfa varsa sil

    On Error Resume Next

    Application.DisplayAlerts = False ' Uyarı mesajlarını kapat

    newWb.Sheets(Islem_Yapilan).Delete

    Application.DisplayAlerts = True ' Uyarı mesajlarını aç

    On Error GoTo 0

    

    ' Verileri yeni çalışma kitabındaki sayfaya aktar

    ws2.Copy After:=newWb.Sheets(1)

    newWb.Sheets(2).Name = Islem_Yapilan

    

    ' Yeni çalışma kitabını kaydet ve kapat

    Application.DisplayAlerts = False ' Uyarı mesajlarını kapat

    ' Dış bağlantıları kır

    Dim link As Variant

    For Each link In newWb.LinkSources(xlLinkTypeExcelLinks)

        newWb.BreakLink Name:=link, Type:=xlLinkTypeExcelLinks

    Next link

    

    ' Yeni çalışma kitabını kaydet ve kapat

    'filePath = ThisWorkbook.Path & "\" & FolderName & "\" & Islem_Yapilan & ".xlsx"

    

    Application.DisplayAlerts = False ' Uyarı mesajlarını kapat

    'newWb.SaveAs Filename:=filePath, FileFormat:=xlOpenXMLWorkbook

    newWb.SaveAs filePath, _

        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

        ReadOnlyRecommended:=False, CreateBackup:=False

        ActiveWorkbook.Close False

    newWb.Close SaveChanges:=False

    Application.DisplayAlerts = True ' Uyarı mesajlarını aç
 
Y

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
218
Excel Vers. ve Dili
Office Pro 2016 TR
Altın Üyelik Bitiş Tarihi
09-02-2028
Güvenlik ayarlarıyla alakalı olabilir mi veya kütüphane mi eksik?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sorun yaşadığınız bilgisayarda kodu F8 ile adıma adım çalıştırıp test edebilirsiniz.
 
Y

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
218
Excel Vers. ve Dili
Office Pro 2016 TR
Altın Üyelik Bitiş Tarihi
09-02-2028
Test ettim hocam ama yine aynı sonuç dosya adını almıyor farklı kaydet çıkıyor
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,588
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Paylaştığınız kod eksik gibi görünüyor.

Tamamını paylaşırsanız deneyebiliriz..
 
Y

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
218
Excel Vers. ve Dili
Office Pro 2016 TR
Altın Üyelik Bitiş Tarihi
09-02-2028
Application.DisplayAlerts = False
Yaptım F8 ile takip ediyorum Application.DisplayAlerts kodu geçtikten sonra üstüne mouse ile geldiğimde True yazıyor kodun üzerinden geçtiğim halde hala öyle bu bir güvenlik ayarı olabilir mi? Sadece o bilgisayarda çalışıyor komple kaldırdım tekrar yükledim sorun hâlâ aynı Bi ara düzelmişti şimdi yine. Sorun kodlarda değil Application.DisplayAlerts False olmuyor
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst