Di module :
Public Sub SetBook()
dim dtTgl as date
dim Wb as workbook
dim sSht as string
On Error Resume Next
'sudah terbuka ?
Set Wb = Workbooks("200912 Allocated Stock.xls")
If err.number<>0 then
'belum terbuka, oleh sebab itu muncul error
'dihapus status errornya
err.clear
'cek sudah ada filenya ?
if lenb( dir( "f:\data\200912 bla.xls") ) <> 0 then
Set Wb = Workbooks.Open("f:\data\200912 bla.xls")
else
'hati-hati disini, jika path (F:\data) belum ada, tetap akan
muncul error
'bisa dicek seperti cara di atas
' if lenb(dir("F:\data")) = 0 then
' 'lakukan buat folder disini
' end if
'jadi sampai sini pasti sudah ada foldernya.
Set Wb = Workbooks.Add
Wb.SaveAs Filename:= "f:\data\200912 bla.xls"
end if
end if
'aktifkan wb set nama sheet
Wb.Activate
dttgl = now()
sSht="ALS" & format$(dttgl,"dd")
'Cek ada sheet dimaksud di wb gak ?
Sheets(ssht).select
if err.number <> 0 then 'muncul error = gak ada sheet ssht
err.clear
sheets.add after:= sheets(sheets.count)
sheets(sheets.count).name = ssht
end if
'sampai sini, pasti sudah terbuka si workbook wb dan sudah ada si sheet
ssht
'proses selanjutnya adalah copy paste
'letakkan disini atau di prosedur lain, yang dipanggil dari sini atau
dari mana saja
'diakhiri proses save dengan
worksbooks.save
End Sub
di event commandbutton click
Public Sub CommandButton1_Click()
SetBook
End Sub
Paket kode seperti ini sering digunakan dan tidak ada masalah.
Sepertinya masalah kode yang lalu (posting terakhir) adalah saat akan buat
sheet baru yang namanya sudah ada. Dari kode di atas, bisa digunakan
potongan kode dari cek sudah ada sheet atau belum.
Kid.
2009/12/2 Ahmad Zamroni <ahza...@gmail.com>
>
>
> Trima kasih, Mr. Kid
>
>
>
> Belum jalan seperti seharusnya, malah di pembentukan file yang belum ada
> muncul error, di yang saya buat sebelumnya gak muncul.
>
> Permasalahan yang saya hadapi diantaranya adalah:
>
>
>
> On Error Resume Next
>
> Set Wb = Workbooks("200912 Allocated Stock.xls")
>
> On Error GoTo 0
>
> If Wb Is Nothing Then
>
> On Error Resume Next
>
> Set Wb = Workbooks.Open("C:\Users\ahzam\Documents\200912 Allocated
> Stock.xls")
>
> On Error GoTo 0
>
> If Wb Is Nothing Then
>
> Set NewBook = Workbooks.Add
>
> NewBook.SaveAs Filename:="C:\Users\ahzam\Documents\200912
> Allocated Stock.xls"
>
> End If
>
> End If
>
>
>
> Logikanya sih, pertama kali akan dicek apakah file 200912 Allocated
> Stock.xls aktif/terbuka?
>
> Jika tidak, maka akan dipanggil/dibuka file tersebut.
>
> Jika dipanggil *tidak datang*, maka artinya file itu belum lahir, sehingga
> perlu di-*create* dulu..
>
>
>
> Jika deretan coding di atas berjalan sebagaimana yang saya harapkan, maka
> sebenarnya yang berikut tidak diperlukan:
>
>
>
> On Error Resume Next
>
> Wb.Close SaveChanges:=True
>
> On Error GoTo 0
>
>
>
> Kenapa harus saya tambahkan itu?
>
> Karena proses insert new sheet tidak jalan ketika file dalam keadaan
> terbuka.
>
>
>
> -zam-
>
>
>
> *From:* belajar-excel@yahoogroups.com [mailto:
> belajar-ex...@yahoogroups.com] *On Behalf Of *Mr. Kid
> *Sent:* Wednesday, December 02, 2009 1:11 PM
>
> *To:* belajar-excel@yahoogroups.com
> *Subject:* Re: [belajar-excel] copy and insert a sheet to other specify
> file/workbook
>
>
>
>
>
> Selamat Siang Mr. Zam.
>
> Sepertinya masalah ada pada peletakan kode (tapi ini kira-kira), karena
> belum bisa membuktikannya.
>
> Coba proses buat workbook baru termasuk save diletakkan pada sebuah module,
> tidak sebagai sebuah routine event object sheet. Kegiatan dalam object sheet
> ada beberapa batasan, yang belum tahu detil batasannya dimana saja.
>
> Ketika kode diletakkan diluar object sheet (dari class worksheet), maka
> kode bekerja sebagai pihak luar walau dipanggil oleh routine dalam object
> sheet.
>
> Jadi, kira-kira seperti ini (hanya copas dari yang ada) :
>
> di sebuah module :
>
>
> Public Sub SaveBook()
>
> Dim Wb As Workbook
>
> on error resume next
>
> Set Wb = Workbooks("200912 Allocated Stock.xls")
>
> On Error GoTo 0
>
> If Wb Is Nothing Then
>
> On Error Resume Next
>
> Set Wb = Workbooks.Open("C:\Users\ahzam\Documents\200912 Allocated
> Stock.xls")
>
> On Error GoTo 0
>
> If Wb Is Nothing Then
>
> Set NewBook = Workbooks.Add
>
> NewBook.SaveAs Filename:="C:\Users\ahzam\Documents\200912
> Allocated Stock.xls"
>
> End If
>
> End If
>
>
> End Sub
>
>
> pada event commandbutton click di object sheet :
>
> Private Sub CommandButton1_Click()
>
> Dim Tgl As String
>
>
>
> Tgl = Range("H1").Value
>
> 'panggil routine SaveBook untuk lakukan create/open lalu save
>
> savebook
>
> On Error Resume Next
>
>
>
>
> Workbooks("200912 Allocated Stock.xls").Sheets.Add
> after:=Sheets(Sheets.Count)
>
> ActiveSheet.Name = "ALS" & Left(Tgl, 2)
>
> Tgl = ActiveSheet.Name
>
>
>
> Application.DisplayAlerts = False
>
> On Error Resume Next
>
> Sheets("Sheet1").Delete
>
> On Error GoTo 0
>
> Application.DisplayAlerts = True
>
>
>
> Workbooks("200912 File Order.xls").Sheets("ALS").Range("B:H").Copy
>
> Workbooks("200912 Allocated
> Stock.xls").Sheets(Tgl).Range("B:H").PasteSpecial (xlPasteValues)
>
> Workbooks("200912 Allocated
> Stock.xls").Sheets(Tgl).Range("B:H").PasteSpecial (xlPasteFormats)
>
>
>
> On Error Resume Next
>
> Wb.Close SaveChanges:=True
>
> On Error GoTo 0
>
>
>
> End Sub
>
>
