Yang ini dongeng tengah malam supaya mimpi indah...
Hati-hati dalam menghayati isi ceritanya, kalau salah tangkap, cerita indah
ini bisa jadi cerita yang menyeramkan... iiiih ngeri...
Public Sub BeberapaCaraSavePilihLokasi()
Dim bSaveAs As Boolean
Dim sFile As String
*'untuk mencoba prosedur ini, pastikan menunjuk folder yang sama
disetiap dialog**
'dan beri nama khusus setiap dialog yang muncul*
'kegiatan pertama dengan dialog pertama
Application.Dialogs(xlDialogSaveAs).Show 'akan langsung save begitu
di ok dan ada nama file
'kegiatan kedua dengan dialog kedua
'untuk beri pesan tentang file tersave atau tidak, simpan return value
dari dialog
If Application.Dialogs(xlDialogSaveAs).Show Then
MsgBox "Saved"
Else
MsgBox "Cancel"
End If
'kegiatan ketiga tanpa dialog
'simpan dan sudah tahu nama tujuan
'tidak muncul dialog dan nama file adalah salinan.xlsm
ThisWorkbook.SaveAs ThisWorkbook.Path & "\salinan.xlsm"
'kegiatan keempat tanpa dialog
'tidak muncul dialog dan nama file adalah salinan_no_vba.xlsx
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\salinan_no_vba.xlsx"
'kegiatan kelima dengan dialog ketiga
'mode buat salinan dengan minta inputan nama filenya dan file aktif
tetap aktif
'(kegiatan dengan method workbook savecopyas)
'minta inputan nama file dengan method getsaveasfilename
'hasil inputan : fullfilename [ada inputan dan tekan save] atau teks
'False' [cancel]
'karena buat salinan, maka hati-hati dengan file filter
'misal dari xlsm jadi xlsx berarti file salinan tidak ada vba dan
format mungkin agak berbeda
'btw, cara susun multi ekstensi dalam 1 kriteria (yaitu kriteria 'xl
salinan') seperti contoh berikut
sFile = Application.GetSaveAsFilename(filefilter:="xl salinan (*.xlsx;
*.xls),*.xlsx;*.xls")
If sFile <> "False" Then
ThisWorkbook.SaveCopyAs sFile
MsgBox "Data dalam file telah disalin ke :" & vbCrLf & sFile
Else
MsgBox "Cancel"
End If
'kegiatan keenam dengan dialog keempat
'mode save jadi nama lain dan hasil save tersebut yang aktif (kegiatan
dengan method workbook save as)
'tetap minta inputan dengan getsaveasfilename
'cara susun filter multi kriteria (umumnya untuk save, 1 ekstensi
setiap 1 kriteria) seperti contoh
sFile = Application.GetSaveAsFilename( _
filefilter:="xl with vba (*.xlsm),*.xlsm,xl binary
(*.xlsb),*.xlsb,xl 2003 kebawah (*.xls),*.xls" _
)
Select Case Right$(sFile, 1)
Case "m"
ThisWorkbook.SaveAs sFile, 52 'file format Excel12
Case "b"
ThisWorkbook.SaveAs sFile, 50 'file format MacroEnable
Case "s"
ThisWorkbook.SaveAs sFile, 56 'file format Excel8
Case Else
MsgBox "Cancel"
Exit Sub
End Select
MsgBox "Save As :" & vbCrLf & sFile
'fyi
'fungsi minta inputan file untuk open (GetOpenFilename)
'filter file bisa multi kriteria yang masing-masing kriteria berisi
multi ekstensi
'coba lihat perbedaan antara menu File -> Open dengan menu File -> Save
As
End Sub
Wassalam,
Kid.
2012/6/23 <[email protected]>
> **
>
>
> ** Wow, excelence Mr. Kid,
> Thank you very much,
>
> But I have one more question Mr.Kid..
>
> Saya membuat coding macro utk menyimpan seperti berikut :
>
> Activeworkbook.Save
>
> Dan dengan coding seperti ini macro akan langsung save di mydocument.
> Kondisi yang diinginkan adalah seperti halnya ketika kita men-save workbook
> akan memilih lokasi penyimpanan dngn memunculkan suatu exploredialog.
>
> Ini agar user dapat memilih lokasi penyimpanannya sendiri.
>
> Bagaimana ya ?
> Mohon Pencerahannya..
> Powered by Telkomsel BlackBerry®
> ------------------------------
> *From: * "Kid Mr." <[email protected]>
> *Sender: * [email protected]
> *Date: *Sat, 23 Jun 2012 19:23:51 +0700
> *To: *<[email protected]>
> *ReplyTo: * [email protected]
> *Subject: *Re: [belajar-excel] Multiple CopySheets dengan VBA Macro
>
>
>
> Coba simak dongeng dalam prosedur berikut :
>
> Public Sub CobaSusunArrayNamaSheet()
> Dim sht As Worksheet
> Dim sShtName() As String
> Dim lShtIdx As Long
> Dim lCalc As Long
>
> lCalc = Application.Calculation 'simpan setting
> kalkulasi excel yang sedang digunakan
> Application.Calculation = xlCalculationManual 'contoh
> set kalkulasi excel dalam mode manual
>
> ReDim sShtName(1 To Sheets.Count) As String
>
> 'dengan loop per object sheet memanfaatkan for each
> lShtIdx = 0
> For Each sht In ThisWorkbook.Worksheets
> lShtIdx = lShtIdx + 1
> sShtName(lShtIdx) = sht.Name 'masukkan nama sheet ke array
> shtname
>
> 'sht.Copy 'copy sheet yang sedang diproses
> (silakan tentukan kemana akan di-paste)
> Next sht
>
> 'tes multiple select semua sheet, ganti select dengan copy jika akan
> copy langsung semua sheet dalam array
> 'meskipun sebenarnya copy sheet bisa dilakukan saat loop semua sheet
> untuk menyusun array nama sheet
> Sheets(sShtName()).Select
>
> 'contoh pemakaian methods calculate
> Application.Calculate 'perintahkan excel untuk
> mengkalkulasi aplikasi
> Sheets(1).Calculate 'perintahkan untuk kalkulasi
> sheet dengan index 1 saja
> Sheets(1).Range("a2:g78,k34:m34").Calculate 'perintahkan untuk
> kalkulasi range tertentu di sheet berindex 1
>
> 'kembali ke array sheet
> 'susun array nama sheet dengan loop per object sheet memanfaatkan for
> terhadap index sheet
> For lShtIdx = 1 To Sheets.Count
> sShtName(lShtIdx) = Sheets(lShtIdx).Name 'masukkan nama
> sheet ke array shtname
>
> 'sht.Copy 'copy sheet yang sedang diproses
> (silakan tentukan kemana akan di-paste)
> Next lShtIdx
>
> 'tes multiple select semua sheet, ganti select dengan copy jika akan
> copy langsung semua sheet dalam array
> 'meskipun sebenarnya copy sheet bisa dilakukan saat loop semua sheet
> untuk menyusun array nama sheet
> Sheets(sShtName()).Select
>
> Application.Calculation = xlCalculationAutomatic 'pasksa mode
> kalkulasi excel jadi automatic
>
> 'kayanya lebih enak dikembalikan ke selera user saat sebelum proses
> ini dijalankan
> 'jadi kembalikan mode kalkulasi ke mode yang disimpan dalam variabel
> lcalc tadi
> Application.Calculation = lCalc
> End Sub
>
> Wassalam,
> Kid.
>
> 2012/6/23 <[email protected]>
>
>> Dear All Pakar Excel,
>>
>> Saya sedang membuat coding macro, akan tetapi saya menemukan kesulitan
>> ketika harus meng copy lebih dari 1 sheet secara bersamaan. Ketika saya
>> rekam macro hasilnya keluar seperti berikut :
>>
>> Sheets(array("Sheet1","Sheet2","Sheet3")).copy
>>
>> Masalahnya adalah jumlah sheets yg ingin saya copy jumlah dan namanya
>> tidak tetap akan tetapi indexnya yang sama yaitu sheets dengan index 5
>> sampai sheets terakhir. Saya coba dengan menggunakan index dngn coding
>> sebagai berikut
>>
>> Sheets(array(1,2,3)).copy
>>
>> Ternyata bisa jika diganti index.
>> Jd saya buat codingnya seperti berikut :
>>
>> For x=5 to sheets.count
>>
>> Array ????
>>
>> Next
>>
>> Sheets(array???).copy
>>
>> End sub
>>
>> Pertanyaan saya adalah, bagaimana membuat arraynya agar flexibel ?
>>
>> Mohon pencerahannya.
>>
>> Terimakasih
>>
>> Best regards
>> Powered by Telkomsel BlackBerry®
>>
>> ------------------------------------
>>
>> ---------------------------------------------------------------------
>> bergabung ke milis (subscribe), kirim mail kosong ke:
>> [email protected]
>>
>> posting ke milis, kirimkan ke:
>> [email protected]
>>
>> berkunjung ke web milis
>> http://tech.groups.yahoo.com/group/belajar-excel/messages
>>
>> melihat file archive / mendownload lampiran
>> http://www.mail-archive.com/[email protected]/
>> atau (sejak 25-Apr-2011) bisa juga di :
>> http://milis-belajar-excel.1048464.n5.nabble.com/
>>
>> menghubungi moderators & owners: [email protected]
>>
>> keluar dari membership milis (UnSubscribe):
>> kirim mail kosong ke [email protected]
>> ---------------------------------------------------------------------Yahoo!
>> Groups Links
>>
>>
>>
>>
>
>
