Buat name sheet di Range pakai vb Excel

nama sheet di taruh di B1
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
[B1]=[B1]&","& sh.Name
Next sh

Nama Sheet di taruh di B1 ke bawah

For i = 1 To Sheets.Count
Cells(i, 2) = Sheets(i).Name
Next i

Nama Sheet di buat data validasi Vba excel

Private Sub CommandButton1_Click()
Dim wsArray As Variant
    Dim sWsList As String
    Dim x As Integer
    wsArray = AllWorkSheets()
    sWsList = Join(wsArray, ",")
    With Sheets(1).Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=sWsList
    End With
End Sub
Public Function AllWorkSheets() As Variant
    Dim wsArray() As Variant
    Dim x As Integer
        ReDim wsArray(Sheets.Count - 1)
        For x = 0 To Sheets.Count - 1
        wsArray(x) = Sheets(x + 1).Name
    Next x
        AllWorkSheets = wsArray
    End Function

Nama Sheet di buat ComboBox Vba excel

Private Sub Worksheet_Activate()
ComboBox1.Clear
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
Me.ComboBox1.AddItem sh.Name
Next sh
End Sub

Vb Mengurutkan Name sheet di Excel

Dim a, b, c, p As Integer
On Error GoTo Gagal

c = Sheets.Count
For a = 2 To c 
  p = a
  For b = a - 1 To 1 Step -1
    If Sheets(a).Name < Sheets(b).Name Then
      p = b
    End If   
  Next
  If p <> a Then
    Sheets(a).Move Before:=Sheets(p)
  End If
Next

Sheets(1).Select

Gagal:

Memper Kecil Ukuran Fail dengan VBA Excel

cara memperkecil fail excel dengan menghapus Object yang ada di Sheet
Sub hapusObject()
Dim gambar As Shape
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
For Each gambar In sh.Shapes
   gambar.Delete
   Next gambar
Next sh
ActiveWorkbook.Save
End Sub

Border dengan VBA excel

Buat Angsuran pinjaman menurun dengan VBA Excel

Private Sub Ags_AfterUpdate()
If Ags <> "" Then
ListBox1.Clear
Call TampilList
Dim a As Integer
For a = 1 To 12
 With ListBox1
.AddItem
 .List(.ListCount - 1, 0) = a
 .List(.ListCount - 1, 1) = Format(WorksheetFunction.EDate(Now(), (a)), "mmmm yyyy;@")
 .List(.ListCount - 1, 2) = "Rp." & Format(Ags - ((Ags / 12) * (a - 1)), "###,###")
 .List(.ListCount - 1, 3) = "Rp." & Format((Ags - ((Ags / 12) * (a - 1))) * (5 / 100), "###,###")
 .List(.ListCount - 1, 4) = "Rp." & Format(Ags / 12, "###,###")
 .List(.ListCount - 1, 5) = "Rp." & Format(Ags / 12 + (Ags - ((Ags / 12) * (a - 1))) * (5 / 100), "###,###")
 .List(.ListCount - 1, 6) = "Rp." & Format(Ags - ((Ags / 12) * a), "###,###")
  End With
 Next a
 Ags.Value = Format(Ags.Value, "###,###")
 End If
End Sub
Sub TampilList()
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Ags." ' Kolom pertama
.List(.ListCount - 1, 1) = "Tanggal" 'Kolom kedua dan seterusnya
.List(.ListCount - 1, 2) = "Saldo"
.List(.ListCount - 1, 3) = "Jasa"
.List(.ListCount - 1, 4) = "Pokok"
.List(.ListCount - 1, 5) = "Jumlah"
.List(.ListCount - 1, 6) = "Saldo"
End With
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
If ListBox1.ListIndex > 0 Then
ListBox1.RemoveItem (ListBox1.ListIndex)
End If
End Sub
Private Sub KELUAR_Click()
TRANSAKSI.TxtPINJ = Format(ANGSURAN.Ags * 1, "#,##0")
Unload Me
End Sub
Private Sub Label36_Click()
ListBox1.Clear
Ags.Value = ""
End Sub

YANG AKU TAKUT

🥀🌻 *YANG AKU TAKUT...*🌻🥀
*_Yang aku takut_*
hatiku kian mengeras dan susah menerima nasihat, namun
*sangat pandai menasihati*.
*_Yang aku takut_*
aku merasa paling benar sehingga
*merendahkan yang lain*.
*_Yang aku takut_*
egoku terlalu tinggi hingga
*merasa paling baik di antara yang lain*.
*_Yang aku takut_*
aku lupa bercermin, namun
*sibuk berprasangka buruk kepada yang lain*.
*_Yang aku takut_*
ilmuku akan membuatku
*menjadi sombong, memandang rendah yang berbeda denganku*.
*_Yang aku takut_*
lidahku makin lincah membicarakan aib saudaraku, namun
*_lupa dengan aibku_*
*_yang menggunung dan tak sanggup kubenahi_*.
*_Yang aku takut_*
aku hanya hebat dalam berkata, namun
*_buruk dalam bertindak_*
*_Yang aku takut_*
aku hanya pintar dalam berdakwah, namun
*_susah untuk mentaati_*
*_Yang aku takut_*
aku hanya cerdas dalam mengkritik,  namun
*_lemah dalam mengintrospeksi diri sendiri_*
*_Yang aku takut_*
aku membenci dosa orang lain namun
*_saat aku sendiri berbuat dosa, aku enggan membencinya_*.
*_Ya Allah ya Rabb* ...
*aku berlindung padaMu*
*dari kelemahanku sendiri*
*Lembutkanlah hatiku*
*dan redam egoku*
*Jauhkan aku*
*dari sifat berbangga diri*,
*hasad*,
*iri dan dengki*.
_*Yaa Allah, yaa Robbi*_
*Sungguh*
*_aku memohon hidayah_*
*_dan ampunanMu_*
*Aamiin Yaa Rabbal 'Aalamiin*....

Angka ke terbilang vba excel

Private Sub CommandButton2_Click()
Dim i As Integer, a As Integer, MyNumber As Integer
For i = 7 To 50
Dim myarray(9) As String
        myarray(0) = " Zero "
        myarray(1) = "One"
        myarray(2) = "Two"
        myarray(3) = "Three"
        myarray(4) = "Four"
        myarray(5) = "Five"
        myarray(6) = "Six"
        myarray(7) = "Seven"
        myarray(8) = "Eight"
        myarray(9) = "Nine"
For a = 1 To Len(Range("B" & i).Value)
tmp = myarray(Mid(Range("B" & i), a, 1))
Range("C" & i) = Range("C" & i) & " " & tmp
Next a
        Next i
End Sub


UserFormya :Private Sub TextBox1_Change()
If TextBox1 <> "" Then
TextBox2 = Len(TextBox1)
Dim myarray(9) As String
        myarray(0) = " Zero "
        myarray(1) = "One"
        myarray(2) = "Two"
        myarray(3) = "Three"
        myarray(4) = "Four"
        myarray(5) = "Five"
        myarray(6) = "Six"
        myarray(7) = "Seven"
        myarray(8) = "Eight"
        myarray(9) = "Nine"
  Dim i As Integer, tmp As String
For i = 1 To Len(TextBox1)
tmp = tmp & " " & myarray(Mid(TextBox1, i, 1))
Next
  TextBox3 = tmp
          End If
End Sub

Singkat kata dengan VBA Excel

Private Sub TextBox1_Change()
Dim i As Integer, tmp As String, kangim() As String
kangim = Split(TextBox1)
For i = LBound(kangim) To UBound(kangim)
tmp = tmp & Mid(kangim(i), 1, 1)
Next
TextBox2 = tmp
End Sub

Kalao menggunakan UDF

Function Singkatan(ref As Range) As String
Dim i As Integer, tmp As String, kangim() As String
kangim = Split(ref)
For i = LBound(kangim) To UBound(kangim)
tmp = tmp & Mid(kangim(i), 1, 1)
Next
Singkatan = tmp
End Function

cara gunakannya
=Singkatan(B1)

Mengatasi ListView1 error lvwReport

dowonload active control 6
https://www.microsoft.com/en-us/download/confirmation.aspx?id=10019

Menggunakan Dua Office Sekaligus Dalam Satu Computer

Untuk menggunakan Dua Office dalam satu Computer, yang paling di butuhkan adalah kode perintah untuk menambahkan settingan di Registri computer kamu, berikut kodenya:
1. Kode untuk office 2003

reg add HKCU\Software\Microsoft\Office\11.0\Word\Options /v NoReReg /t REG_DWORD /d 1

2. Kode untuk office 2007

reg add HKCU\Software\Microsoft\Office\12.0\Word\Options /v NoReReg /t REG_DWORD /d 1

3. Kode untuk office 2010

reg add HKCU\Software\Microsoft\Office\14.0\Word\Options /v NoReReg /t REG_DWORD /d 1

4. Kode untuk office 2013
reg add HKCU\Software\Microsoft\Office\15.0\Word\Options /v NoReReg /t REG_DWORD /d 1

masukkan ke kotak Run

Cek semua TextBox ComboBox CheckBox kosong dengan VBA

Sub Cekdata()
Dim ctr As Control
For Each ctr In Me.Controls
If TypeOf ctr Is MSForms.TextBox Or TypeOf ctr Is MSForms.ComboBox Or TypeOf ctr Is MSForms.CheckBox Then
If ctr = vbNullString Or ctr = False Then
MsgBox ctr.Name & "Masih Kosong"
ctr.SetFocus
Exit Sub
End If
End If
Next ctr
End Sub