6 New Messages
Digest #1905
Messages
Wed Nov 14, 2012 1:57 am (PST) . Posted by:
"him mah"
mungkin bisa untuk menambah pengetahuan, bisan digunakan untuk menu pembukaan
http://itknowledgeexchange.techtarget.com/beyond-excel/animating-your-companys-logo-in-excel/
Private Sub Workbook_Open()
Worksheets("Data").Activate
ActiveSheet.Shapes("Logo").LockAspectRatio = False
GrowShape ActiveSheet.Shapes("Logo"), 10
SpinShape ActiveSheet.Shapes("Logo"), 10
End Sub
Function GrowShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:Expands a shape into view
' Parameters: Shape The shape to animate
' Step Larger #s animate faster
' Example: GrowShape ActiveSheet.Shapes("Logo"), 10
' Note: For best results, shape should be hidden before calling
' this routine
' Date Init Modification
' 01/10/11 CWH Initial Programming
Dim lCenterX As Long 'Shape's center X coordinate
Dim lCenterY As Long 'Shape's center Y coordiante
Dim lWidth As Long 'Shape's width
Dim lHeight As Long 'Shape's height
Dim l As Long 'Generic Counter for the loop
Application.ScreenUpdating = False
With Shape
'Remember shape's original dimensions
lCenterX = .Width / 2 + .Left
lCenterY = .Height / 2 + .Top
lWidth = .Width
lHeight = .Height
'Animation Loop
For l = 0 To lWidth Step Step
.Width = l
.Height = l * lHeight / lWidth
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
Shape.Visible = True
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Next l
'Restore shape's original dimensions
.Width = lWidth
.Height = lHeight
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
End With
Application.ScreenUpdating = True
End Function
Function SpinShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:Expands a shape into view
' Parameters: Shape The shape to animate
' Step Larger #s animate faster
' Steps should divide 90 evenly
' Example: SpinShape ActiveSheet.Shapes("Logo"), 10
' Date Init Modification
' 01/10/11 CWH Initial Programming
Const Pi = 3.14159265358979
Dim sng01 As Single '1 Degree in Radians
sng01 = Pi / 180
Dim lCenterX As Long 'Shape's center X coordinate
Dim lCenterY As Long 'Shape's center Y coordiante
Dim lWidth As Long 'Shape's width
Dim lHeight As Long 'Shape's height
Dim l As Long 'Generic Counter for the loop
Application.ScreenUpdating = False
With Shape
.LockAspectRatio = False
'Remember shape's original dimensions
lCenterX = .Width / 2 + .Left
lCenterY = .Height / 2 + .Top
lWidth = .Width
lHeight = .Height
'Animation Loop
For l = 0 To 360 Step Step
.Width = lWidth * Abs(Cos(l * sng01))
.Left = lCenterX - .Width / 2
If l = 90 Or l = 270 Then .Flip msoFlipHorizontal
Shape.Visible = True
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Next l
'Restore shape's original dimensions
.Width = lWidth
.Height = lHeight
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
End With
Application.ScreenUpdating = True
End Function
http://itknowledgee
Private Sub Workbook_Open(
Worksheets("
ActiveSheet.
GrowShape ActiveSheet.
SpinShape ActiveSheet.
End Sub
Function GrowShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:
' Parameters: Shape The shape to animate
' Step Larger #s animate faster
' Example: GrowShape ActiveSheet.
' Note: For best results, shape should be hidden before calling
' this routine
' Date Init Modification
' 01/10/11 CWH Initial Programming
Dim lCenterX As Long 'Shape's center X coordinate
Dim lCenterY As Long 'Shape's center Y coordiante
Dim lWidth As Long 'Shape's width
Dim lHeight As Long 'Shape's height
Dim l As Long 'Generic Counter for the loop
Application.
With Shape
'Remember shape's original dimensions
lCenterX = .Width / 2 + .Left
lCenterY = .Height / 2 + .Top
lWidth = .Width
lHeight = .Height
'Animation Loop
For l = 0 To lWidth Step Step
.Width = l
.Height = l * lHeight / lWidth
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
Shape.Visible = True
Application.
Application.
Next l
'Restore shape's original dimensions
.Width = lWidth
.Height = lHeight
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
End With
Application.
End Function
Function SpinShape(ByRef Shape As Shape, Step As Integer) As Boolean
' Description:
' Parameters: Shape The shape to animate
' Step Larger #s animate faster
' Steps should divide 90 evenly
' Example: SpinShape ActiveSheet.
' Date Init Modification
' 01/10/11 CWH Initial Programming
Const Pi = 3.14159265358979
Dim sng01 As Single '1 Degree in Radians
sng01 = Pi / 180
Dim lCenterX As Long 'Shape's center X coordinate
Dim lCenterY As Long 'Shape's center Y coordiante
Dim lWidth As Long 'Shape's width
Dim lHeight As Long 'Shape's height
Dim l As Long 'Generic Counter for the loop
Application.
With Shape
.LockAspectRatio = False
'Remember shape's original dimensions
lCenterX = .Width / 2 + .Left
lCenterY = .Height / 2 + .Top
lWidth = .Width
lHeight = .Height
'Animation Loop
For l = 0 To 360 Step Step
.Width = lWidth * Abs(Cos(l * sng01))
.Left = lCenterX - .Width / 2
If l = 90 Or l = 270 Then .Flip msoFlipHorizontal
Shape.Visible = True
Application.
Application.
Next l
'Restore shape's original dimensions
.Width = lWidth
.Height = lHeight
.Left = lCenterX - .Width / 2
.Top = lCenterY - .Height / 2
End With
Application.
End Function
Wed Nov 14, 2012 2:03 am (PST) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Kan sebelum buat workbook baru sudah diubah dulu jumlah sheet bawaan excel
ketika buat workbook baru dengan properti sheetsinnewworkbook. Coba deh
dibaca ulang.
contoh :
dim lBuiltInSht as long
lbuiltinsht=application.sheetsinneworkbook 'simpan dulu settingan
kesenangan user
application.sheetsinneworkbook=1
'buat workbook baru disini
'copas sheet disini dengan opsi selalu after
application.displayalerts=false
wbkt.sheets(1).delete
application.displayalerts=true
application.sheetsinneworkbook=lbuiltinsht
'simpan workbook baru disini
'tutup sekalian juga boleh
'selesai deh
Wassalam,
Kid.
2012/11/14 him mah <himmah.mlg@gmail.com >
> application.sheetsinneworkbook
ketika buat workbook baru dengan properti sheetsinnewworkbook
dibaca ulang.
contoh :
dim lBuiltInSht as long
lbuiltinsht=
kesenangan user
application.
'buat workbook baru disini
'copas sheet disini dengan opsi selalu after
application.
wbkt.sheets(
application.
application.
'simpan workbook baru disini
'tutup sekalian juga boleh
'selesai deh
Wassalam,
Kid.
2012/11/14 him mah <himmah.mlg@gmail.
> application.
Wed Nov 14, 2012 2:07 am (PST) . Posted by:
"him mah"
iya pak KID sudah bisa, makasih
oh iya himmah itu anak saya, kalau saya bapaknya himmah
selamat libur panjang Pak KId, dan untuk semua anggota milis be-Excel
2012/11/14, Mr. Kid <mr.nmkid@gmail.com >:
> Kan sebelum buat workbook baru sudah diubah dulu jumlah sheet bawaan excel
> ketika buat workbook baru dengan properti sheetsinnewworkbook. Coba deh
> dibaca ulang.
>
> contoh :
> dim lBuiltInSht as long
> lbuiltinsht=application.sheetsinneworkbook 'simpan dulu settingan
> kesenangan user
> application.sheetsinneworkbook=1
>
> 'buat workbook baru disini
> 'copas sheet disini dengan opsi selalu after
>
> application.displayalerts=false
> wbkt.sheets(1).delete
> application.displayalerts=true
>
> application.sheetsinneworkbook=lbuiltinsht
>
> 'simpan workbook baru disini
> 'tutup sekalian juga boleh
>
> 'selesai deh
>
> Wassalam,
> Kid.
>
>
> 2012/11/14 him mah <himmah.mlg@gmail.com >
>
>> application.sheetsinneworkbook
>
oh iya himmah itu anak saya, kalau saya bapaknya himmah
selamat libur panjang Pak KId, dan untuk semua anggota milis be-Excel
2012/11/14, Mr. Kid <mr.nmkid@gmail.
> Kan sebelum buat workbook baru sudah diubah dulu jumlah sheet bawaan excel
> ketika buat workbook baru dengan properti sheetsinnewworkbook
> dibaca ulang.
>
> contoh :
> dim lBuiltInSht as long
> lbuiltinsht=
> kesenangan user
> application.
>
> 'buat workbook baru disini
> 'copas sheet disini dengan opsi selalu after
>
> application.
> wbkt.sheets(
> application.
>
> application.
>
> 'simpan workbook baru disini
> 'tutup sekalian juga boleh
>
> 'selesai deh
>
> Wassalam,
> Kid.
>
>
> 2012/11/14 him mah <himmah.mlg@gmail.
>
>> application.
>
Wed Nov 14, 2012 2:16 am (PST) . Posted by:
"the_x_mikey@yahoo.com" the_x_mikey
Luar biasa mr kid, udah browse google dr pagi akhirnya nemu nya disini. Thanks
-----Original Message-----
From: "Mr. Kid" <mr.nmkid@gmail.com >
Sender: belajar-excel@yahoogroups.com
Date: Wed, 14 Nov 2012 16:55:46
To: <belajar-excel@yahoogroups.com >
Reply-To: belajar-excel@yahoogroups.com
Subject: Re: [belajar-excel] Select image didalam sebuah cell
Coba dengan prosedur berikut :
public sub SelectShapeAh()
dim shp as shape
dim sRngAddr as string 'var ini bisa jadi input parameter agar
lebih luwes
srngaddr = "$D$2"
sheet1.activate
for each shp in sheet1.shapes
if shp.topleftcell.address=srngaddr then
shp.select
endif
next shp
end sub
Wassalam,
Kid.
2012/11/14 <the_x_mikey@yahoo.com >
> **
>
>
> Hi all,
>
> Saya sedang membuat form dimana user akan menginput sebuah image ke dalam
> suatu cell.
> Let's say semua image tersebut ditempatkan di sheet 1 row 2, bagaimana
> jika ingin men-select image yang ada di cell D2 saja?
>
> _
>
>
-----Original Message-----
From: "Mr. Kid" <mr.nmkid@gmail.
Sender: belajar-excel@
Date: Wed, 14 Nov 2012 16:55:46
To: <belajar-excel@
Reply-To: belajar-excel@
Subject: Re: [belajar-excel] Select image didalam sebuah cell
Coba dengan prosedur berikut :
public sub SelectShapeAh(
dim shp as shape
dim sRngAddr as string 'var ini bisa jadi input parameter agar
lebih luwes
srngaddr = "$D$2"
sheet1.activate
for each shp in sheet1.shapes
if shp.topleftcell.
shp.select
endif
next shp
end sub
Wassalam,
Kid.
2012/11/14 <the_x_mikey@
> **
>
>
> Hi all,
>
> Saya sedang membuat form dimana user akan menginput sebuah image ke dalam
> suatu cell.
> Let's say semua image tersebut ditempatkan di sheet 1 row 2, bagaimana
> jika ingin men-select image yang ada di cell D2 saja?
>
> _
>
>
Wed Nov 14, 2012 2:26 am (PST) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Sama-sama.
Jangan lupa, pastikan bahwa sRngAddr benar-benar berisi alamat cell pojok
kiri atas si shape. Kadangkala, si shaope tampak sudah masuk di range D2
padahal masih di D1 atau malah C1.
Wassalam,
Kid.
2012/11/14 <the_x_mikey@yahoo.com >
> **
>
>
> ** Luar biasa mr kid, udah browse google dr pagi akhirnya nemu nya
> disini. Thanks
> ------------------------------
> *From: * "Mr. Kid" <mr.nmkid@gmail.com >
> *Sender: * belajar-excel@yahoogroups.com
> *Date: *Wed, 14 Nov 2012 16:55:46 +0700
> *To: *<belajar-excel@yahoogroups.com >
> *ReplyTo: * belajar-excel@yahoogroups.com
> *Subject: *Re: [belajar-excel] Select image didalam sebuah cell
>
>
>
> Coba dengan prosedur berikut :
>
> public sub SelectShapeAh()
> dim shp as shape
> dim sRngAddr as string 'var ini bisa jadi input parameter agar
> lebih luwes
>
> srngaddr = "$D$2"
> sheet1.activate
> for each shp in sheet1.shapes
> if shp.topleftcell.address=srngaddr then
> shp.select
> endif
> next shp
> end sub
>
> Wassalam,
> Kid.
>
> 2012/11/14 <the_x_mikey@yahoo.com >
>
>> **
>>
>>
>> Hi all,
>>
>> Saya sedang membuat form dimana user akan menginput sebuah image ke dalam
>> suatu cell.
>> Let's say semua image tersebut ditempatkan di sheet 1 row 2, bagaimana
>> jika ingin men-select image yang ada di cell D2 saja?
>>
>> _
>>
>>
>
>
Jangan lupa, pastikan bahwa sRngAddr benar-benar berisi alamat cell pojok
kiri atas si shape. Kadangkala, si shaope tampak sudah masuk di range D2
padahal masih di D1 atau malah C1.
Wassalam,
Kid.
2012/11/14 <the_x_mikey@
> **
>
>
> ** Luar biasa mr kid, udah browse google dr pagi akhirnya nemu nya
> disini. Thanks
> ------------
> *From: * "Mr. Kid" <mr.nmkid@gmail.
> *Sender: * belajar-excel@
> *Date: *Wed, 14 Nov 2012 16:55:46 +0700
> *To: *<belajar-excel@
> *ReplyTo: * belajar-excel@
> *Subject: *Re: [belajar-excel] Select image didalam sebuah cell
>
>
>
> Coba dengan prosedur berikut :
>
> public sub SelectShapeAh(
> dim shp as shape
> dim sRngAddr as string 'var ini bisa jadi input parameter agar
> lebih luwes
>
> srngaddr = "$D$2"
> sheet1.activate
> for each shp in sheet1.shapes
> if shp.topleftcell.
> shp.select
> endif
> next shp
> end sub
>
> Wassalam,
> Kid.
>
> 2012/11/14 <the_x_mikey@
>
>> **
>>
>>
>> Hi all,
>>
>> Saya sedang membuat form dimana user akan menginput sebuah image ke dalam
>> suatu cell.
>> Let's say semua image tersebut ditempatkan di sheet 1 row 2, bagaimana
>> jika ingin men-select image yang ada di cell D2 saja?
>>
>> _
>>
>>
>
>
Wed Nov 14, 2012 4:25 am (PST) . Posted by:
"dhen.baguse" bagusejogja
SIAP laksanakan, akan mencoba dan belajar mengotak atik ilmu dari master-master milis terimakasih atas ilmunya....
wassalam;)
________________________________
From: Jan Raisin <miss.jan.raisin@gmail.com >
To: belajar-excel@yahoogroups.com
Sent: Tuesday, November 13, 2012 8:07 PM
Subject: Re: [belajar-excel] Pembagian ke masing masing sheet
mas den bagus se jogja,
coba tambahkan script berikut ini di bawah deklarasi yang paling akhir, tetapi di atas script yang berbunyi Application.ScreenUpdating = False
' ===================================================================== '
' modified by Miss Jan Raisin '
' untuk millis Belajar Excel '
' 13 November 2012 '
' penambahan script untuk menghapus data lama sebelum menulis data baru '
' ===================================================================== '
' [AwalDariScriptTambahan]
' deklarasikan variabel untuk menyimpan objek berupa worksheet
Dim ws As Worksheet
' yang akan kita lakukan adalah menguji untuk setiap worksheet
' jika nama worksheet tidak sama dengan Input maka
' hapus data mulai dari cell B11 ke arah kanan dan ke bawah
' pertama-tama lakukan Loop terhadap semua worksheet
For Each ws In Worksheets
' lakukan pengujian nama worksheet menggunakan perintah .Name
If ws.Name <> "Input" Then
' hapus data dalam worksheet tersebut mulai dari cell B11
' untuk menunjuk gunakan perintah ws.Range("b11")
' sampai dengan baris paling bawah & paling kanan yang berisi data
' untuk menunjuk gunakan perintah ws.Range("b11").End(xlDown).End(xlToRight)
' perintah untuk menghapusnya adalah .ClearContents
Range(ws.Range("b11"), ws.Range("b11").End(xlDown).End(xlToRight)).ClearContents
' ini adalah penutup dari pengujian nama worksheet
End If
' ini adalah blok penutup dari loop
Next ws
' [/AkhirDariScriptTambahan]
semoga yang ini sudah sesuai dengan yang diharapkan, kalo masih ada yang kurang sesuai coba mas den bagus kutak-katik dulu, nanti kesulitannya silakan dishare lagi ke millis
Best Regard,
Jan Raisin
Pada 13 November 2012 05:00, dhen.baguse <bagusejogja@yahoo.com > menulis:
>
>wah walupun jan bukanlan programer tapi hasilnya sesuai yang diharapkan, ruar binasa dan top markotop seperti di bimbingan les private aje...:)
>mas atau mb jan mau tanya lagi, itu semisal tombol diklik yang ke 2 kalinya kan munculnya data yang sama dan menambahkan dibawahnya, agar tidak membuat tambahan data dibawahnya tapi penghapus yang lama dan menggantik data dari perintah yang baru itu tambahan codingnya gmna jan?
>
>terimakasih jan;)
>
>________________________________
>From: Jan Raisin <miss.jan.raisin@gmail.com >
>To: belajar-excel@yahoogroups.com
>Sent: Monday, November 12, 2012 1:26 PM
>Subject: Re: [belajar-excel] Pembagian ke masing masing sheet
>
>
>
wassalam;)
____________
From: Jan Raisin <miss.jan.raisin@
To: belajar-excel@
Sent: Tuesday, November 13, 2012 8:07 PM
Subject: Re: [belajar-excel] Pembagian ke masing masing sheet
mas den bagus se jogja,
coba tambahkan script berikut ini di bawah deklarasi yang paling akhir, tetapi di atas script yang berbunyi Application
' ============
' modified by Miss Jan Raisin '
' untuk millis Belajar Excel '
' 13 November 2012 '
' penambahan script untuk menghapus data lama sebelum menulis data baru '
' ============
' [AwalDariScriptTamb
' deklarasikan variabel untuk menyimpan objek berupa worksheet
Dim ws As Worksheet
' yang akan kita lakukan adalah menguji untuk setiap worksheet
' jika nama worksheet tidak sama dengan Input maka
' hapus data mulai dari cell B11 ke arah kanan dan ke bawah
' pertama-tama lakukan Loop terhadap semua worksheet
For Each ws In Worksheets
' lakukan pengujian nama worksheet menggunakan perintah .Name
If ws.Name <> "Input" Then
' hapus data dalam worksheet tersebut mulai dari cell B11
' untuk menunjuk gunakan perintah ws.Range("b11"
' sampai dengan baris paling bawah & paling kanan yang berisi data
' untuk menunjuk gunakan perintah ws.Range("b11"
' perintah untuk menghapusnya adalah .ClearContents
Range(ws.Range(
' ini adalah penutup dari pengujian nama worksheet
End If
' ini adalah blok penutup dari loop
Next ws
' [/AkhirDariScriptTa
semoga yang ini sudah sesuai dengan yang diharapkan, kalo masih ada yang kurang sesuai coba mas den bagus kutak-katik dulu, nanti kesulitannya silakan dishare lagi ke millis
Best Regard,
Jan Raisin
Pada 13 November 2012 05:00, dhen.baguse <bagusejogja@
>
>wah walupun jan bukanlan programer tapi hasilnya sesuai yang diharapkan, ruar binasa dan top markotop seperti di bimbingan les private aje...:)
>mas atau mb jan mau tanya lagi, itu semisal tombol diklik yang ke 2 kalinya kan munculnya data yang sama dan menambahkan dibawahnya, agar tidak membuat tambahan data dibawahnya tapi penghapus yang lama dan menggantik data dari perintah yang baru itu tambahan codingnya gmna jan?
>
>terimakasih jan;)
>
>___________
>From: Jan Raisin <miss.jan.raisin@
>To: belajar-excel@
>Sent: Monday, November 12, 2012 1:26 PM
>Subject: Re: [belajar-excel] Pembagian ke masing masing sheet
>
>
>
GROUP FOOTER MESSAGE
---------------------------------------------------------------------
bergabung ke milis (subscribe), kirim mail kosong ke:
belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke:
belajar-excel@yahoogroups.com
berkunjung ke web milis
http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran
http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di :
http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe):
kirim mail kosong ke belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
bergabung ke milis (subscribe), kirim mail kosong ke:
belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke:
belajar-excel@yahoogroups.com
berkunjung ke web milis
http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran
http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di :
http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe):
kirim mail kosong ke belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
Tidak ada komentar:
Posting Komentar