Buka Password (Menampilkan)

 Sub PasswordBreaker()

'Breaks worksheet password protection.

Dim i As Integer, j As Integer, k As Integer

Dim l As Integer, m As Integer, n As Integer

Dim i1 As Integer, i2 As Integer, i3 As Integer

Dim i4 As Integer, i5 As Integer, i6 As Integer

On Error Resume Next

For i = 65 To 66: For j = 65 To 66: For k = 65 To 66

For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66

For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66

For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _

Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _

Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If ActiveSheet.ProtectContents = False Then

MsgBox "One usable password is " & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

Exit Sub

End If

Next: Next: Next: Next: Next: Next

Next: Next: Next: Next: Next: Next

End Sub

QR COde

 Function Buat_QR(codetext As String)

Dim URL As String, MyCell As Range

Set MyCell = Application.Caller

URL = "https://chart.googleapis.com/chart?chs=125x125&cht=qr&chl=" & codetext

On Error Resume Next

ActiveSheet.Pictures("MyQR_" & MyCell.Address(False, False)).Delete

On Error GoTo 0

ActiveSheet.Pictures.Insert(URL).Select

With Selection.ShapeRange(1)

.PictureFormat.CropLeft = 2

.PictureFormat.CropRight = 2

.PictureFormat.CropTop = 2

.PictureFormat.CropBottom = 2

.Name = "MyQR_" & MyCell.Address(False, False)

.Left = MyCell.Left + 25

.Top = MyCell.Top + 5

End With

Buat_QR = "" ' Masukkan text sebagai optional

End Function

Print Raport MAM 1

'=======Cetak_Raport_MAM1=========
Sub cetak_banyak()
Dim mulai As Byte
Dim sampai As Byte
Dim a As Byte
mulai = Range("U3").Value
sampai = Range("V3").Value
For a = mulai To sampai
Range("M1") = a
Sheet44.PrintOut from:=1, To:=3, Copies:=1
Next a
Sheet44.Select
End Sub


Goal Sek - Analisa

 Sub goalsek()

'

' goalsek Macro

'

  Selection.GoalSeek Goal:=842, ChangingCell:=Selection.Offset(0, -1)

    

    

End Sub

Bris Terakhir

Menuju Baris terakhir : 

Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Value
nilainya berupa value dari cell tersebut
===========================
irow = Sheet1.Cells(Rows.Count, 1).End (xlUp).Offset(1, 0).row
nilainya berupa nomor baris 

Ebook Trik Excel

 klik di sini

uCase Looping

 klik di sini

https://trumpexcel.com/vba-ucase/