KUMPULAN SCRIPT VISUAL BASIC

( VB ) MICROSOFT EXCEL
0 comment

Kumpulan Script Visual Basic ( VB ) Microsoft Excel

Kita perlu mempelajari Visual Basic ( VB ) yang ada di Microsoft Excel. Karena Script ini
jika kita buat akan memudahkan orang bekerja jika aplikasi sudah jadi. Bagi orang yang
ingin belajar bahasa pemograman Visual Basic memang dari Microsoft Excel sebagai
dasar belajarnya karena mudah dipahami. Selamat mempelajari materi yang saya tulis
ini semoga bermanfaat.

Coding VBA (Macro) Excel Menampikan Dokumen Di Layar Monitor

Sub PrintPreview()
Worksheets("Sheet1").PrintPreview

End Sub

Sheet1 disesuaikan nama sheetnya. Misal nama sheet diganti informatika ya di script
disesuaikan

Coding VBA (Macro) Excel Menyimpan File Yang Baru Dibuat

Sub Save()
[Link]
End Sub

Coding VBA (Macro) Excel Keluar File

Sub Quit()
[Link]
End Sub

Coding VBA (Macro) Excel Menyisipkan Gambar Di Dokumen

Sub insertpic()

Dim FilestoOpen

FilestoOpen = [Link]("Picture File (*.jpg), *.jpg,(*.png), *.png", ,

"Insert Picture", , False)

[Link] (OpenFilestoOpen)

End Sub

Coding VBA (Macro) Excel Backup File

Sub FileBackUp()
[Link] Filename:=[Link] & _
"" & Format(Date, "mm-dd-yy") & " " & _
[Link]
End Sub

Coding VBA (Macro) Menutup Semua File Kecuali yang Aktif

Sub CloseAllWorkbooks()
Dim wbs As Workbook
For Each wbs In Workbooks
[Link] SaveChanges:=True
Next wbs
End Sub

Coding VBA (Macro) Menyembunyikan Worksheet

Sub HideWorksheet()
Dim ws As Worksheet
For Each ws In [Link]
If [Link] <> [Link] Then
[Link] = xlSheetHidden
End If
Next ws
End Sub

Coding VBA (Macro) Menampilkan Semua Worksheet yang Tersembunyi

Sub UnhideAllWorksheet()
im ws As Worksheet
For Each ws In [Link]
[Link] = xlSheetVisible
Next ws
End Sub

Coding VBA (Macro) Menghapus Semua Worksheet

Sub DeleteWorksheets()
Dim ws As Worksheet
For Each ws In [Link]
If [Link] <> [Link] Then
[Link] = False
[Link]
[Link] = True
End If
Next ws
End Sub

Coding VBA (Macro) Mengcopy Sheet Aktif kedalam Workbook Baru

Sub CopyWorksheetToNewWorkbook()
[Link] _
Before:=[Link](1)
End Sub

Coding VBA (Macro) Proteksi Semua Worksheet

Sub ProtectAllWorskeets()
Dim ws As Worksheet
Dim ps As String
ps = InputBox("Enter a Password.", vbOKCancel)
For Each ws In [Link]
[Link] Password:=ps
Next ws
End Sub

Coding VBA (Macro) Mengkonversi Rumus kedalam Format Value

Sub ConvertToValues()
Dim MyRange As Range
Dim MyCell As Range
Select Case MsgBox("You Can't Undo This Action. " & "Save Workbook First?",
vbYesNoCancel, "Alert")
Case Is = vbYes
[Link]
Case Is = vbCancel
Exit Sub
End Select
Set MyRange = Selection
For Each MyCell In MyRange
If [Link] Then
[Link] = [Link]
End If
Next MyCell
End Sub

Coding VBA (Macro) Menghapus Spasi

Sub RemoveSpaces()
Dim myRange As Range
Dim myCell As Range
Select Case MsgBox("You Can't Undo This Action. " & "Save Workbook First?", _
vbYesNoCancel, "Alert")
Case Is = [Link]
Case Is = vbCancel
Exit Sub
End Select
Set myRange = Selection
For Each myCell In myRange
If Not IsEmpty(myCell) Then
myCell = Trim(myCell)
End If
Next myCell
End Sub

Coding VBA (Macro) Memberi Tanda Data yang Dianggap Ganda (Duplikat)

Sub HighlightDuplicateValues()
Dim myRange As Range
Dim myCell As Range
Set myRange = Selection
For Each myCell In myRange
If [Link](myRange, [Link]) > 1 Then
[Link] = 36
End If
Next myCell
End Sub

Coding VBA (Macro) Mengimpor File Excel Ke PDF

Sub SaveAsPDF()
[Link] Type:=xlTypePDF, OpenAfterPublish:=True
End Sub

Coding VBA (Macro) Menghapus Karakter dari String

Public Function removeFirstC(rng As String, cnt As Long)

Coding VBA (Macro) Menyimpan Range kedalam Bentuk Gambar

Sub PasteAsPicture()
[Link] = False
[Link]
[Link]
End Sub

Coding VBA (Macro) Cara Memberikan Tanda pada 10 Besar

Sub TopTen()
[Link].AddTop10
[Link]([Link]).SetFirstPriority
With [Link](1)
.TopBottom = xlTop10Top
.Rank = 10
.Percent = False
End With
With [Link](1).Font
.Color = -16752384
.TintAndShade = 0
End With
With [Link](1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
[Link](1).StopIfTrue = False
End Sub

Coding VBA (Macro) Menambahkan Nomor Seri (Serial Number)

Sub AddSerialNumbers()
Dim i As Integer
On Error GoTo Last
i = InputBox("Enter Value", "Enter Serial Numbers")
For i = 1 To i
[Link] = i
[Link](1, 0).Activate
Next i
Last:
Exit Sub
End Sub

Coding VBA (Macro) Protek dan Unprotect Worksheet

Sub ProtectWS()
[Link] "mypassword", True, True
End Sub

Sub UnprotectWS()
[Link] "mypassword"
End Sub

Coding VBA (Macro) Merubah Tulisan Menjadi Huruf Besar

Sub ConvertUpperCase()
Dim rng As Range
For Each rng In Selection
rng = UCase(rng)
Next rng
End Sub

Coding VBA (Macro)Merubah Tulisan Menjadi Hurup Kecil

Sub ConvertLowerCase()
Dim rng As Range
For Each rng In Selection
rng = LCase(rng)
Next rng
End Sub

Coding VBA (Macro) Menyesuaikan Kolom dan Baris Sesuai Ukuran atau Lebar
Text

Sub AutoFitColumns()
[Link]
[Link]
End Sub

Sub AutoFitRows()
[Link]
[Link]
End Sub
Coding VBA (Macro) Mengurutkan Nama Worksheet

Sub SortWorksheets()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To [Link]
For j = 1 To [Link] - 1
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub

Coding VBA (Macro) Membuat text to Speak

Sub Speak()
[Link]
End Sub

Coding VBA (Macro) Menutup Pesan Otomatis

Sub auto_close()
MsgBox "Bye Bye! Don't forget to check other cool stuff on [Link]"
End Sub

Coding VBA (Macro)Konversi Format Tanggal ke Text

Sub date2day()
Dim tempCell As Range
[Link] = [Link]
For Each tempCell In Selection
If IsDate(tempCell) = True Then
With tempCell
.Value = Day(tempCell)
.NumberFormat = "0"
End With
End If
Next tempCell
End Sub

Coding VBA (Macro) Konversi Tanggal Menjadi Tahun

Sub date2year()
Dim tempCell As Range
[Link] = [Link]
For Each tempCell In Selection
If IsDate(tempCell) = True Then
With tempCell
.Value = Year(tempCell)
.NumberFormat = "0"
End With
End If
Next tempCell
End Sub

Coding VBA (Macro) Membuat Header dan Footer

Coding VBA (Macro) Menghapus Karakter

Sub removeChar()
Dim Rng As Range
Dim rc As String
rc = InputBox("Character(s) to Replace", "Enter Value")
For Each Rng In Selection
[Link] What:=rc, Replacement:=""
Next
End Sub

Coding VBA (Macro) Menghapus Desimal

Sub removeDecimals()
Dim lnumber As Double
Dim lResult As Long
Dim rng As Range
For Each rng In Selection
[Link]= Int(rng)
[Link]= "0"
Next rng
End Sub

Coding VBA (Macro) Mengunci /Proteksi Cell yang ada Formulanya

Sub lockCellsWithFormulas()
With ActiveSheet
.Unprotect
.[Link] = False
.[Link](xlCellTypeFormulas).Locked = True
.Protect AllowDeletingRows:=True
End With
End Sub

Coding VBA (Macro) Menampilkan tulisan A-Z dalam sekejap

Sub addcAlphabets()
Dim i As Integer
For i= 65 To 90
[Link]= Chr(i)
[Link](1, 0).Select
Next i
End Sub

Sub addsAlphabets()
Dim i As Integer
For i= 97 To 122
[Link]= Chr(i)
[Link](1, 0).Select
Next i
End Sub

Coding VBA (Macro) Menghapus Cell Kosong

Sub deleteBlankWorksheets()
Dim Ws As Worksheet
On Error Resume Next
[Link]= False
[Link]= False
For Each Ws In [Link]
If [Link]([Link]) = 0 Then
[Link]
End If
Next
[Link]= True
[Link]= True
End Sub

Coding VBA (Macro) Memberikan Tanda pada Data yang Dianggap Unik

Sub highlightUniqueValues()
Dim rng As Range
Set rng = Selection
[Link]
Dim uv As UniqueValues
Set uv = [Link]
[Link] = xlUnique
[Link] = vbGreen

End Sub