farklı kaydet problemi

[by_IsTaNBuL]

aşağıdaki kodlarla sayfayı farklı kaydet yaparak masaüstüne kaydediyorum.
sorun şurda; eğer çalışma kitabı makro içerebilen çalışma kitabı
olarak kaydilmişşe masaüstüne atılan sayfayı açarken normal olarak açılıyor.
fakat excel 97-2003 olarak kaydedilmiş bir çalışma kitabından masaüstüne sayfayı farklı kaydet yaptığım zaman şu uyarı çıkıyor.
açmaya çalıştığınız 'dosya uzantısı ......dosya adı......xls' dosyası, dosya uzantısı tarafından belirlenen farklı bir biçimde .dosyayı açmadan önce bozulmadığını ve güvenilir bir kaynaktan geldiğini doğrulayın . diyor .
aç diyorum dosyayı açıyor fakat biraz sonra . ofis sorunla karşılaştı deyip dosyayı kapatıyor . yardımcı olursanız çok sevinirim .
şimdiden teşekkürler.





Private Sub CommandButton87_Click()

Klasor = Worksheets("MMAIL").Range("AH4").Value (dosya adını sayfadan hücreden alıyor)

Dosya_Adi = Worksheets("MMAIL").Range("Z2").Value
Sayfa_Adı = "MMAIL"

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Set Sourcewb = ActiveWorkbook

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim wb As Workbook
Set wb = ActiveWorkbook

With wb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'MsgBox "HATA VAR"
FileExtStr = Right(Sourcewb.Name, 5)
FileFormatNum = 52
'Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(Klasor & Dosya_Adi & FileExtStr)
If a = True Then
MsgBox "Bu isimde bir dosya var"
'Exit Sub
Else

Dim sayfa As Worksheet
For Each sayfa In Worksheets
If sayfa.Name = Sayfa_Adı Then
sayfa.Copy

ActiveWorkbook.SaveAs Klasor & Dosya_Adi & FileExtStr, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & FileExtStr & " Dosya kayıt edildi"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If

Next
End If

End Sub

 

[halit3]

aşağıdaki kodlarla sayfayı farklı kaydet yaparak masaüstüne kaydediyorum.
sorun şurda; eğer çalışma kitabı makro içerebilen çalışma kitabı
olarak kaydilmişşe masaüstüne atılan sayfayı açarken normal olarak açılıyor.
fakat excel 97-2003 olarak kaydedilmiş bir çalışma kitabından masaüstüne sayfayı farklı kaydet yaptığım zaman şu uyarı çıkıyor.
açmaya çalıştığınız 'dosya uzantısı ......dosya adı......xls' dosyası, dosya uzantısı tarafından belirlenen farklı bir biçimde .dosyayı açmadan önce bozulmadığını ve güvenilir bir kaynaktan geldiğini doğrulayın . diyor .
aç diyorum dosyayı açıyor fakat biraz sonra . ofis sorunla karşılaştı deyip dosyayı kapatıyor . yardımcı olursanız çok sevinirim .
şimdiden teşekkürler.

Kodunuzda sorun yok çalışıyor alternatif olarak aşağıdaki kodu denermisiniz.

not;dosyanızın uzantısı ney ise o uzantıda farklı kayıt ediyor örnek ofis 2003 formatlı xls uzantılı dosyayı ofis 2007 de açarsanız xlsx burada bu kodu çalıştırırsanız kodda hata verecektir bu durumda dosyayı önce ofis 2007 ye xlsx formatına dönüştürünüz.

Private Sub CommandButton87_Click()
Klasor = Worksheets("MMAIL").Range("AH4").Value '(dosya adını sayfadan hücreden alıyor)
Dosya_adi = Worksheets("MMAIL").Range("Z2").Value
Sayfa_Adı = "MMAIL"
For i = Len(ThisWorkbook.Name) To 1 Step -1
If Mid(ThisWorkbook.Name, i, 1) = "." Then
'Dosya_adi = Mid(ThisWorkbook.Name, 1, i - 1)
Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
Exit For
End If
Next
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(Klasor & Dosya_adi & Uzanti)
MsgBox Klasor & Dosya_adi & Uzanti
If a = True Then
MsgBox "Bu isimde bir dosya var"
'Exit Sub
Else
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
If sayfa.Name = Sayfa_Adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = Sayfa_Adı
ActiveWorkbook.SaveAs Klasor & Dosya_adi & Uzanti
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
End If
End Sub

 

[by_IsTaNBuL]

Halit bey teşekkür ederim

ancak soruyu tam olarak analatamamış olabilirim. ama benim sıkıntım kodun çalışmamamsında değil. gayet güzel masaüstüne kaydediyor sayfayı makrolarıda siliyor ( kanaatimce ) , fakat sorun bundan sonra başlıyor. masaüstüne kaydettiğim dosya 2007 makro içerebilen dosya şeklide kaydedilmişse sorun olmadan açılıyor. yok hayır. dosya 2003 excelden masaüstüne kaydedilmişse hata vererek açılıyor bir zaman sonrada kapanıyor. sıkıntım bu.

benim istediğim ise. dosya ister 2007 makro içerebilen dosyadan masaüstüne kaydedilsin. istersede 2003 excel den masaüstüne kaydedilsin. her ikisindede sorunsuz açılsın.

eğer kod üzerinde ne gibi değişiklik yaparsam bunu başarırım ??
çok teşekkür ederim tekrar ilginize

 

[halit3]

ancak soruyu tam olarak analatamamış olabilirim. ama benim sıkıntım kodun çalışmamamsında değil. gayet güzel masaüstüne kaydediyor sayfayı makrolarıda siliyor ( kanaatimce ) , fakat sorun bundan sonra başlıyor. masaüstüne kaydettiğim dosya 2007 makro içerebilen dosya şeklide kaydedilmişse sorun olmadan açılıyor. yok hayır. dosya 2003 excelden masaüstüne kaydedilmişse hata vererek açılıyor bir zaman sonrada kapanıyor. sıkıntım bu.

benim istediğim ise. dosya ister 2007 makro içerebilen dosyadan masaüstüne kaydedilsin. istersede 2003 excel den masaüstüne kaydedilsin. her ikisindede sorunsuz açılsın.

eğer kod üzerinde ne gibi değişiklik yaparsam bunu başarırım ??
çok teşekkür ederim tekrar ilginize

Sorunuzla ilgili 2 nolu mesajın not bölümündeki açıklama doğrultusunda işlem yapmanız yok sa kodunuz güzel çalıyor.

Bir örnek vereyim 2003 formatındaki bir dosyayı 2007 de açtığınız zaman ve kodu çalıştırdığınızda dosya 2007 formatında ancak uzantısı 2003 formatında olacağından bu farklı kayıt edilen dosyayı ofis 2003 de açmak istediğiniz vakit dosyada hatalar oluşacaktır.

1-dosyayı ofis 2003 de açtığınız zaman kayıtlarda bu doğrultuta yapacağından yapılan kayıtlı dosyaları ofis 2003 de açtığınız zaman hiç bir sıkıntı vermiyecektir.

2-dosyayı ofis 2007 de açtığınız zaman kayıtlarda bu doğrultuta yapacağından yapılan kayıtlı dosyaları ofis 2007 de açtığınız zaman hiç bir sıkıntı vermiyecektir.

3-ofis 2003 dosyasını ofis 2007 açtığınızda ve kayıt yaptığınızda fiziksel özellikleri 2007 formatında ve uzantısı 2003 formatında olacağından bu kayıtlı dosyayı açtığınızda hata verecektir

Yapmanız gereken 2003 formatlı dosyayı ofis 2003 de açmak, eğer ofis 2007 de açacaksanız bunu önce farklı kayıt et seçeneğinden 2007 formatına çevirmelisiniz zira kodu 2007 ye çevirmeden kodu çalıştırdığınızda farklı kayıt edilen dosyayı açtığınızda hata alacaksınız.

Dilimin döndüğünce anlatmaya çalıştım.

 

[halit3]

Birde bu kodu denermisiniz.

Private Sub CommandButton87_Click()
Klasor = Worksheets("MMAIL").Range("AH4").Value '(dosya adını sayfadan hücreden alıyor)
Dosya_adi = Worksheets("MMAIL").Range("Z2").Value
Sayfa_Adı = "MMAIL"
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim wb As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case wb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(Klasor & Dosya_adi & FileExtStr)
If a = True Then
MsgBox " Bu isimde bir dosya var"
Application.DisplayAlerts = False
ActiveWindow.Close
Else
wb.SaveAs Klasor & Dosya_adi & FileExtStr, FileFormat:=FileFormatNum
wb.Close SaveChanges:=False
MsgBox Klasor & Dosya_adi & FileExtStr & " Dosya kayıt edildi"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub