Masaüstüne yeni excel dosyası açma problemi

[gnorar]

Masaüstüne kullanıcıdan bağımsız aşağıdaki makro ile yeni excel dosyası açtırıyorum. Eğer masaüstünde açtırdığım dosyanın adında başka bir dosya varsa yeni dosyayı açımayıp dosyanın var olduğunu belirden bir uyarı vermesini nasıl sağlarım?

Sub Kaydet()
Dim Ad As String
Ad = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop") & _
Application.PathSeparator & "MalzemeListesi.xls"
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Ad
ActiveWorkbook.Close
End Sub

 

[leumruk]

Masaüstüne kullanıcıdan bağımsız aşağıdaki makro ile yeni excel dosyası açtırıyorum. Eğer masaüstünde açtırdığım dosyanın adında başka bir dosya varsa yeni dosyayı açımayıp dosyanın var olduğunu belirden bir uyarı vermesini nasıl sağlarım?

Merhaba,
Aşağıdaki kodu deneyin:

Sub Kaydet()
Dim Ad As String
Ad = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop") & _
Application.PathSeparator & "MalzemeListesi.xls"
Set ds = CreateObject("Scripting.FileSystemObject")
If ds.FileExists(Ad) = False Then
Application.ScreenUpdating = False
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Ad
ActiveWorkbook.Close
Else:
MsgBox "Bu isimde kayıtlı bir dosya bulunduğundan kayıt yapılmayacak...", vbCritical, "UYARI"
End If
End Sub

 

[gnorar]

İstediğim makro buydu. Teşekkürler.

 

[gnorar]

Bir sorun oluştu. Ana dosyadadan MalzemeListesi dosyasına elektronik, bilgisayar, mekanik, sarf, malzemeleri, genel durum olmak üzere 5 sayfayı ana dosyada kullandığım formüller hariç (yani sadece değerler) kopyalatmam lazım. Bu nasıl yapılır?

 

[leumruk]

Bir sorun oluştu. Ana dosyadadan MalzemeListesi dosyasına elektronik, bilgisayar, mekanik, sarf, malzemeleri, genel durum olmak üzere 5 sayfayı ana dosyada kullandığım formüller hariç (yani sadece değerler) kopyalatmam lazım. Bu nasıl yapılır?

Merhaba,

    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues

kod satırından istifade edebilirsiniz. Daha kesin bir çözüm için örnek dosya eklemelisiniz.

 

[gnorar]

Bir örnek yükledim.
Yapmak istediğim: Envater dosyasının Elektronik, Bilgisayar, Mekanik sayfalarını eğer masaüstünde malzeme listesi adında bir dosya yoksa malzeme listesi diye bir excel dosyası açtırıp sadece bu üç sayfayı adlarıyla birlikte içine kopyalamak. Acak kopyalarken sadece veriler ve biçimleri kopyalanacak, formüller ve makrolar kopyalanmayacak.

 

[leumruk]

Merhaba,

Sub Kaydet2()
Dim Ad As String
Ad = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop") & _
Application.PathSeparator & "MalzemeListesi.xls"
Set ds = CreateObject("Scripting.FileSystemObject")
If ds.FileExists(Ad) = False Then
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Add
deg = Array("", "Elektronik", "Bilgisayar", "Mekanik")
Application.ScreenUpdating = False
For x = 1 To 3
xlbook.Worksheets(x).Name = deg(x)
Sheets(deg(x)).Cells.Copy
xlbook.Worksheets(deg(x)).[a1].PasteSpecial Paste:=xlPasteValues
Next
xlbook.SaveAs Filename:=Ad
xlbook.Close False
Application.CutCopyMode = False
Else:
MsgBox "Bu isimde kayıtlı bir dosya bulunduğundan kayıt yapılmayacak...", vbCritical, "UYARI"
End If
End Sub

 

[gnorar]

Hocam kod güzel çalışmakta. Ancak sayfaları kopyalarken hücre biçimleri, satır genişlikleri ve stün yüksekliklerini kopyalamıyor. Sayfaların hücre biçimleri, satır genişlikleri ve stün yüksekliklerini de kopyalatabilirsek mükemmel olacak. Yardımlarınızı bekliyorum.