DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
3 nolu mesajdaki dosyaya baktınızmı.?sn halit3 bey üstteki yazım alıntılarınıza cevap olacak niteliktedir sanırım. sorunu çözebilirsem uyarılarınıza uymaya çalışacağım
yukarıdaki yazdığınız işlemi yapıyor 3 nolu mesajdaki linkmakrolarla düzenlediğim sayfayı farklı kaydet dediğimde makrosuz sadece düzenlenmiş sayfaların olduğu bir excel sayfası açılsın istiyorum bu mümkün müdür?
halit3 bey çok teşekkür ederim dosyanız bilgisayarımın en güzüde yerinde duruyor şimdi. çok i,şime yaradı saolun bir kez dahayukarıdaki yazdığınız işlemi yapıyor 3 nolu mesajdaki link
bu düğmelere bir tıklayın ne işlemi yapıyor gözleyiniz.sayfaları çalışma kitabı yap içindeki makroları sil
bu sayfayı çalışma kitabı yap makroları sil
Sayın alfaoz :halit3 bey dosyanız güzel ve inceledim ancak BİLMİŞLİK yapmanın luzumu yok yukarıdaki yazımı okursanız denediğimi yazdım sonuçlarınıda yazdım ve karşılaştığım sorunlarıda yazdım
siz gönderdiğim dosyayı bir deneyin sonra itamda bulunursunuz. üsteki yazımı okuyun bi zahmet olacak size.
Ben size gene aynı şeyi söylüyorum .buarada dip not düşmeliyim halit beyin verdiği dosyada farklı kaydet özelliğini kullanamadım hangisine tıklayacağımı bilemedim. dosya içindeki sayfaları ayrı ayrı sayfalar halinde kaydeden bi tanesi var ancak onda da bazı sayfalar yine makrolu olarak kaydediliyor.
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
bana göre dosyayı incelememişsiniz sadece bakmışınız.Sub çalışmakitabıyapkodlarısil()
deger = InputBox("dosyanın adı adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)
deger1 = InputBox("Sayfanın adını değiştirebilirsiniz.", "UYARI!", "sayfa1")
'dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
kaynak = Klasor.items.Item.Path
If Len(kaynak) = 3 Then
kaynak = Mid(kaynak, 1, 2)
Else
kaynak = kaynak
End If
If Not Klasor Is Nothing Then
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_Adı Then
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(kaynak & "\" & sayfa.Name & ".xls")
If a = True Then
MsgBox "Bu isimde bir dosya var"
Exit Sub
Else
sayfa.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
Sheets(ActiveSheet.Name).Name = deger1
ActiveWorkbook.SaveAs kaynak & "\" & deger & ".xls"
ActiveWorkbook.Close False
Exit Sub
End If
End If
Next sayfa
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub