├── CRUD Excel Access └── Coming Soon.txt ├── Form Input Excel (CRUD) ├── Video #1 Design Database dan UserForm │ └── Lat_UserForm.xlsm └── Video #2 Script Input │ └── Lat_UserForm.xlsm ├── Googe AppScript ├── Conditional Border │ └── code.gs ├── Form Input Sederhana │ └── code.gs ├── Geocoding API │ └── code.gs └── HideRow.gs ├── README.md ├── VBA Tips & Trick Files ├── Andi Setiadi - ModTaskIcon.bas ├── Andi Setiadi - Warna Otomatis Hari Libur.xlsx ├── Aplikasi SPP live.xlsm ├── CRUD Listbox Method List.xlsm ├── CRUD.xlsm ├── ContextMenuSheet.bas ├── Encode Base64 │ └── ImageToBase64.bas ├── File Hasil G Meet 18 juni 2023.xlsm ├── Form Input Multi Column Combobox.xlsm ├── Game_Control_VBA.bas ├── Jadwal Shalat.bas ├── Kirim Email GMail dari Excel.bas ├── Kirim Email Outlook (Early Binding).bas ├── Kirim Email Outlook (Late Binding).bas ├── Maximize_Minimize_API.bas ├── Membuat Banyak Sheet.bas ├── PlaceHolderVBA.bas ├── Readme.md ├── Setiadi.my.id - Aplikasi Jadwal Shalat.xlsm ├── Setiadi.my.id - ImageCombobox.xlsm ├── Setiadi.my.id - Menampilkan PDF di UserForm.xlsm ├── Setiadi.my.id - Menghitung Data Unik.xlsx ├── Setiadi.my.id - Userform Always On Top.xlsm ├── Setiadi.my.id - VBA Fun Hujan.xlsm ├── Setiadi.my.id - VBA Google & Youtube Search.xlsm ├── ShortcutShiftF3Excel.bas ├── UploadFileFTP.bas ├── VBA CalendarForm │ ├── CalendarForm.rar │ └── readme.md ├── VBAPushNotification.bas ├── VBAUserformTransparent.bas ├── andi setiadi - FilterXML.xlsx ├── coba.hta ├── comboboxunik.bas ├── highlightCell.bas ├── joinIF.bas ├── setiadi.my.id - Multi Sheet 1 file PDF .xlsm └── setiadi.my.id - Text Berjalan dan Jam Berjalan.xlsm └── images ├── Andi Setiadi.png └── file.md /CRUD Excel Access/Coming Soon.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/CRUD Excel Access/Coming Soon.txt -------------------------------------------------------------------------------- /Form Input Excel (CRUD)/Video #1 Design Database dan UserForm/Lat_UserForm.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/Form Input Excel (CRUD)/Video #1 Design Database dan UserForm/Lat_UserForm.xlsm -------------------------------------------------------------------------------- /Form Input Excel (CRUD)/Video #2 Script Input/Lat_UserForm.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/Form Input Excel (CRUD)/Video #2 Script Input/Lat_UserForm.xlsm -------------------------------------------------------------------------------- /Googe AppScript/Conditional Border/code.gs: -------------------------------------------------------------------------------- 1 | function onEdit(e) { 2 | 3 | var ss = SpreadsheetApp.getActiveSheet(); 4 | 5 | var rng = e.range; 6 | 7 | if (rng.getColumn() == 2 && rng.getValue() != ''){ 8 | var cell = ss.getRange(rng.getRow(), 1); 9 | var waktu = Utilities.formatDate( new Date(),'GMT+7', 'dd MMM yyyy hh:mm:ss'); 10 | cell.setValue(waktu) //timestamp 11 | 12 | var cfcell = ss.getRange(rng.getRow(), 1, 1, 5); 13 | cfcell.setBorder(true, true, true, true, true, false, 'red',SpreadsheetApp.BorderStyle.DOTTED); 14 | }else if (rng.getValue() == ''){ 15 | var cell = ss.getRange(rng.getRow(), 1); 16 | cell.setValue('') //timestamp 17 | 18 | var cfcell = ss.getRange(rng.getRow(), 1, 1, 5); 19 | cfcell.setBorder(true, false, false, false, false, false, 'red',SpreadsheetApp.BorderStyle.DOTTED); 20 | 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /Googe AppScript/Form Input Sederhana/code.gs: -------------------------------------------------------------------------------- 1 | function Simpan() { 2 | var Sheet = SpreadsheetApp.getActiveSpreadsheet(); 3 | var shtinput = Sheet.getSheetByName('Input'); 4 | var shtdb = Sheet.getSheetByName('Database'); 5 | 6 | var id = shtinput.getRange('D3').getValue(); 7 | var nama = shtinput.getRange('D5').getValue(); 8 | var tgl = shtinput.getRange('D7').getValue(); 9 | var alamat = shtinput.getRange('D9').getValue(); 10 | var sekolah = shtinput.getRange('D11').getValue(); 11 | 12 | var baris = shtdb.getRange('F1').getValue(); 13 | baris += 1; 14 | var rangeisi = shtdb.getRange('A' + baris + ':E'+ baris); 15 | rangeisi.setValues([[id,nama,tgl,alamat,sekolah]]); 16 | bersih(); 17 | } 18 | 19 | function bersih() { 20 | var Sheet = SpreadsheetApp.getActiveSpreadsheet(); 21 | var shtinput = Sheet.getSheetByName('Input'); 22 | 23 | shtinput.getRange('D3').clearContent(); 24 | shtinput.getRange('D5').clearContent(); 25 | shtinput.getRange('D7').setValue('1/1/2000'); 26 | shtinput.getRange('D9').clearContent(); 27 | shtinput.getRange('D11').clearContent(); 28 | } 29 | -------------------------------------------------------------------------------- /Googe AppScript/Geocoding API/code.gs: -------------------------------------------------------------------------------- 1 | function ubahgeocode(alamat){ 2 | var jsn = Maps.newGeocoder().geocode(alamat); 3 | for (var i=0;i< jsn.results.length;i++){ 4 | var res = jsn.results[i]; 5 | return res.geometry.location.lat + ", " + res.geometry.location.lng; 6 | } 7 | 8 | } 9 | 10 | function reversegeocode(lat, long){ 11 | var jsn = Maps.newGeocoder().reverseGeocode(lat, long); 12 | return jsn.results[0].formatted_address; 13 | 14 | } 15 | 16 | function hitungJarak(asal,tujuan){ 17 | 18 | var mapobj = Maps.newDirectionFinder(); 19 | mapobj.setOrigin(asal); 20 | mapobj.setDestination(tujuan); 21 | var hasil = mapobj.getDirections(); 22 | 23 | return hasil.routes[0].legs[0].distance.value; 24 | } 25 | 26 | function hitungJarakLat(lat1,long1,lat2,long2){ 27 | 28 | var mapobj = Maps.newDirectionFinder(); 29 | mapobj.setOrigin(lat1, long1) 30 | mapobj.setDestination(lat2,long2); 31 | var hasil = mapobj.getDirections(); 32 | 33 | return hasil.routes[0].legs[0].distance.value; 34 | 35 | } 36 | -------------------------------------------------------------------------------- /Googe AppScript/HideRow.gs: -------------------------------------------------------------------------------- 1 | function onEdit(e) { 2 | 3 | var namasheet = 'Tagian'; 4 | var kolom = '4'; 5 | var nilai = 'Lunas'; 6 | 7 | var ss = SpreadsheetApp.getActiveSpreadsheet(); 8 | var sheet = ss.getActiveSheet(); 9 | 10 | var rng = e.range; 11 | 12 | if (namasheet == ss.getSheetName() && kolom == rng.getColumn()) { 13 | if ( nilai == rng.getValue()){ 14 | sheet.hideRows(rng.getRow()); 15 | } 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Author](https://img.shields.io/badge/author-Andi%20B.%20Setiadi-lightgrey.svg?colorB=1D63DC&style=flat-square)]() 2 | [![Maintenance](https://img.shields.io/badge/Maintained%3F-yes-green.svg)](https://GitHub.com/ba5tz/StrapDown.js/graphs/commit-activity) 3 | [![Ask Me Anything !](https://img.shields.io/badge/Ask%20me-anything-1abc9c.svg)](https://GitHub.com/Ba5tz) 4 | 5 |
6 |

7 | 8 |

Andi Setiadi YouTube Channel

9 | 10 |

11 | Excel. Google Sheet . Macro 12 |
13 | Explore » 14 |
15 |
16 | YouTube Channel 17 | · 18 | Website 19 | · 20 | Request Tutorial 21 |

22 |

23 | 24 | 25 | ###### YouTube Channel: https://youtube.com/andisetiadii 26 | 27 | ```js 28 | Belikan Saya Kopi: 29 | https://lynk.id/setiadi 30 | 31 | Business Inquiries: 32 | email : saya@setiadi.my.id 33 | website : https://setiadi.my.id 34 | ``` 35 | ----- 36 | ### Playlist 37 | * [Materi VBA Dasar](#materi-vba-dasar) 38 | * [VBA Tips & Trick](#vba-tips-and-trick) 39 | * [Formula Tips & Trick](#Formula-tips-and-trick) 40 | * [VBA CRUD (Create, Read, Update, Delete)](#vba-crud) 41 | * [VBA CRUD Google Sheet](#vba-google-sheet) 42 | * [VBA Fun](#vba-fun) 43 | * [Google AppScript](#google-apps-script) 44 | 45 | ## Materi VBA Dasar 46 | List video berisi tutorial Visual Basic for Applications (VBA) dari Dasar 47 | 1. Mengenal Visual Basic Editor 48 | 2. Type Data | Type Data #2 49 | 3. Operator | Operator #2 50 | 4. Komentar 51 | 5. Message Box 52 | 6. For Next 53 | 7. For Each Next 54 | 8. Do While Loop 55 | 9. Do Until Loop 56 | 10. Penggunaan IF 57 | 12. Select Case 58 | 14. Subrutine 59 | 15. Subrutine Parameters 60 | 16. Function 61 | 17. Function Recursive 62 | 18. Array 63 | 19. With 64 | 20. Static 65 | 21. ParamArray 66 | 22. Enum (Enumeration) 67 | 68 | ## VBA Tips and Trick 69 | Berisi Tips dan Trick dalam menggunakan VBA, pada list ini juga berisi hasil penyelsaikan kasus-kasus VBA yang ditanyakan melalui email atau telegram. 70 | 1. Mengisi Cell/Range dengan VBA 71 | 2. 5 Cara mengisi Combobox 72 | 3. Menjalankan Script VBA di Android 73 | 4. Merubah Warna Visual Basic Editor 74 | 5. Membuka VBE dengan Tombol 75 | 6. Multi Events 76 | 7. Membuat Shortcut untuk Comment dan Uncomment di VBE 77 | 8. Membuat Running Text 78 | 9. Export Multi Sheet Menjadi 1 File PDF 79 | 10. Mengirim Email Gmail dengan VBA (CDO) 80 | 11. Mengirim Email Gmail dengan VBA dengan Attachment (CDO) 81 | 12. Runtime ERROR dan Compile Error 82 | 13. Sheet Code Name, Sheet Tab Name dan Sheet Index 83 | 14. Mengirim Email Melalui Outlook dengan VBA 84 | 15. Membuat Banyak Sheet Sekaligus 85 | 16. Parse JSON dengan VBA 86 | 17. Membuat File DBF Dengan VBA 87 | 18. Upload File ke Web dengan FTP menggunakan VBA 88 | 19. Disable Copy & Paste Di Excel dengan VBA 89 | 20. Mencetak dan Menampilkan File PDF di UserForm 90 | 21. Menghapus Baris Sesuai Kriteria 91 | 22. Menampilkan Garfik pada Userform VBA 92 | 23. Membuat Userform VBA selalu tampil diatas Aplikasi lain 93 | 24. Menambah Icon ke Userform VBA 94 | 25. Copy Text ke Clipboard 95 | 26. Perbedaan TEXT, VALUE dan VALUE2 96 | 27. Cara menambahkan Deskripsi pada UDF (User Defined Function) 97 | 28. Mengolah File JSON dengan PowerQuery dan VBA 98 | 29. Rumus Mengitung Berdasarkan warna (VBA) 99 | 29. Menambah Maximize dan Minimize pada Userform 100 | 101 | ## Formula Tips and Trick (Excel & Google Sheet) 102 | Berisi tutorial tentang Formula yang ada di Spreadsheet baik Excel ataupun Google Sheet dengan Tips dan Trick yang bisa mempermudah pekerjaan. 103 | 1. Lookup Data Terkahir di Excel VS Google Sheet 104 | 1. Rumus Filter (Google Sheet) 105 | 2. Rumus Menghitung Berdasarkan Warna tanpa VBA (Excel) 106 | 3. Rumus konversi Masehi ke Hijariah 107 | 4. Cara Koreksi Jawaban siswa dengan mudah pake Excel 108 | 5. FilterXML Trick 109 | 6. Menghitung Jumalah Kata 110 | 7. Rumus Tambah Kurang kali dan Bagi 111 | 8. Rumus Untuk Menggabungkan Isi Cell 112 | 9. Rumus Menampilkan Isi List File Tanpa VBA 113 | 10. Membuat Warna otomatis pada Hari libur 114 | 11. Rumus Mengubah Angka Menjadi Angka Arab 115 | 12. Rumus Menghitung Rentang Umur 116 | 13. Rumus Membuat Tanggal Acak 117 | 14. Memisahkan Kata Menjadi Perhuruf 118 | 15. Membuat Warna otomatis Libur yang berbeda 119 | 16. Trik Mengisi dan Menambah Cell Kosong 120 | 121 | ## VBA CRUD 122 | Membuat CRUD (Create, Read, Update dan Delete) sebuah form untuk menyimpan data, mengedit dan menghapus langsung ke worksheet Excel 123 | 1. Design UserForm 124 | 2. VBA Simpan (Create) 125 | 126 | ## VBA Google Sheet 127 | Membuat CRUD (Create, Read, Update dan Delete) sebuah form untuk menyimpan data, mengedit dan menghapus langsung Dari VBA Excel ke Google Sheet menggunakan API Google Sheet 128 | 1. Input VBA Excel Form ke Google Sheet 129 | 130 | ## VBA Fun 131 | Have Fun with VBA! 132 | 1. Membuat Google Search & YouTube Search Dengan VBA 133 | 2. Animated Login Form Dengan VBA 134 | 3. Membuat Game Control Sederhana dengan VBA 135 | 4. Membuat Aplikasi Jadwal Shalat dan Imsak (Auto Update) 136 | 137 | ## Google Apps Script 138 | Tutorial Google Apps script (GAS) sebuah macro yang bisa digunakan dalam Google Sheet atau Produk Google lainnya 139 | 1. Form Input Sederhana 140 | 2. TimeStamp dan Conditional Border 141 | 3. Menambah Formula ke Respon Google Form 142 | 4. Google Sheet Geocoding dan Reverse Geocoding 143 | 5. Menampilkan Gambar Hasil Respon Google Form 144 | 6. Google Sheet Menghitung Jarak dengan Alamat dan LatLong 145 | 146 | 147 | ## Tutorial CustomUI / Ribbon Menu 148 | Tutorial membuat CustomUI atau Ribbon Menu di Excel 149 | 1. Episode 1: Konsep dasar 150 | 2. Episode 2: Install CustomUI Editor & CustomUI RibbonX Editor 151 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Andi Setiadi - ModTaskIcon.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "ModTaskIcon" 2 | Option Explicit 3 | Rem Andi Setiadi 4 | Rem https://youtube.com/andisetiadii 5 | 6 | Private Type GUID 7 | Data1 As Long 8 | Data2 As Integer 9 | Data3 As Integer 10 | Data4(0 To 7) As Byte 11 | End Type 12 | 13 | 14 | Private Type PROPERTYKEY 15 | fmtid As GUID 16 | pid As Long 17 | End Type 18 | 19 | 20 | #If VBA7 Then 21 | 22 | Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) 23 | Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long 24 | Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long) 25 | Private Declare PtrSafe Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long 26 | Private Declare PtrSafe Function ExtractIconA Lib "Shell32.dll" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As LongPtr) As Long 27 | Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long 28 | Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As Any) As Long 29 | Private Declare PtrSafe Function SHGetPropertyStoreForWindow Lib "Shell32.dll" (ByVal hwnd As LongPtr, ByRef riid As GUID, ByRef ppv As LongPtr) As Long 30 | Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr 31 | Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long 32 | Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long 33 | Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr 34 | Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr 35 | Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long 36 | Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long 37 | Private Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long 38 | Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long 39 | Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As LongPtr) As Long 40 | Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long 41 | 42 | #Else 43 | 44 | Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 45 | Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 46 | Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 47 | Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long 48 | Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long) 49 | Private Declare Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As Long) As Long 50 | Private Declare Function ExtractIconA Lib "Shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long 51 | Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long 52 | Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, ByRef cGUID As Any) As Long 53 | Private Declare Function SHGetPropertyStoreForWindow Lib "Shell32.dll" (ByVal hwnd As Long, ByRef riid As GUID, ByRef ppv As Long) As Long 54 | Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 55 | Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 56 | Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long 57 | Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long 58 | Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long 59 | Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long 60 | Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long 61 | Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long 62 | Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long 63 | Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long 64 | Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long 65 | 66 | #End If 67 | 68 | Public Sub ChangeExcelIcon _ 69 | (Optional ByVal Reset As Boolean = False, _ 70 | Optional ByVal IconGambar As StdPicture, _ 71 | Optional ByVal IconFile As String, _ 72 | Optional ByVal FileIconIndex As Long = 0, _ 73 | Optional taskcaption As String _ 74 | ) 75 | 76 | 77 | Const VT_LPWSTR = 31 78 | 79 | #If Win64 Then 80 | Const vTblOffsetFac_32_64 = 2 81 | Dim hVbe As LongLong, pPstore As LongLong, pTBarList As LongLong 82 | Dim PV(0 To 2) As LongLong 83 | 84 | PV(0) = VT_LPWSTR: PV(1) = StrPtr("Dummy") 85 | #Else 86 | Const vTblOffsetFac_32_64 = 1 87 | Dim hVbe As Long, pPstore As Long, pTBarList As Long 88 | Dim PV(0 To 3) As Long 89 | 90 | PV(0) = VT_LPWSTR: PV(2) = StrPtr("Dummy") 91 | #End If 92 | 93 | 94 | Const IPropertyKey_SetValue = 24 * vTblOffsetFac_32_64 95 | Const IPropertyKey_Commit = 28 * vTblOffsetFac_32_64 96 | Const ITASKLIST3_HrInit = 12 * vTblOffsetFac_32_64 97 | Const ITASKLIST3_AddTab = 16 * vTblOffsetFac_32_64 98 | Const ITASKLIST3_DeleteTab = 20 * vTblOffsetFac_32_64 99 | Const ITASKLIST3_ActivateTab = 24 * vTblOffsetFac_32_64 100 | Const ITASKLIST3_Settaskcaption = 76 * vTblOffsetFac_32_64 101 | 102 | 103 | Const IID_PropertyStore = "{886D8EEB-8CF2-4446-8D02-CDBA1DBDCF99}" 104 | Const IID_PropertyKey = "{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}" 105 | Const CLSID_TASKLIST = "{56FDF344-FD6D-11D0-958A-006097C9A090}" 106 | Const IID_TASKLIST3 = "{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}" 107 | 108 | Const CLSCTX_INPROC_SERVER = &H1 109 | Const S_OK = 0 110 | Const CC_STDCALL = 4 111 | 112 | Const GWL_STYLE = (-16) 113 | Const WS_MINIMIZEBOX = &H20000 114 | Const GWL_HWNDPARENT = (-8) 115 | 116 | Dim tClsID As GUID, tIID As GUID, tPK As PROPERTYKEY 117 | 118 | If Reset Then 119 | Call addicon(True) 120 | ElseIf Not IconGambar Is Nothing Then 121 | Call addicon(, IconGambar, , FileIconIndex) 122 | ElseIf Len(IconFile) Then 123 | Call addicon(, , IconFile, FileIconIndex) 124 | End If 125 | 126 | Call CLSIDFromString(StrPtr(IID_PropertyStore), tIID) 127 | If SHGetPropertyStoreForWindow(Application.hwnd, tIID, pPstore) = S_OK Then 128 | Call CLSIDFromString(StrPtr(IID_PropertyKey), tPK) 129 | tPK.pid = 5 ': PV(0) = VT_LPWSTR: PV(1) = StrPtr("Dummy") 130 | Call vtblCall(pPstore, IPropertyKey_SetValue, vbLong, CC_STDCALL, VarPtr(tPK), VarPtr(PV(0))) 'SetValue Method 131 | Call vtblCall(pPstore, IPropertyKey_Commit, vbLong, CC_STDCALL) ' Commit Method 132 | Call CLSIDFromString(StrPtr(CLSID_TASKLIST), tClsID) 133 | Call CLSIDFromString(StrPtr(IID_TASKLIST3), tIID) 134 | 135 | If CoCreateInstance(tClsID, 0, CLSCTX_INPROC_SERVER, tIID, pTBarList) = S_OK Then 136 | SetProp Application.hwnd, "pTBarList", pTBarList 137 | Call vtblCall(pTBarList, ITASKLIST3_HrInit, vbLong, CC_STDCALL) 'HrInit Method 138 | Call vtblCall(pTBarList, ITASKLIST3_DeleteTab, vbLong, CC_STDCALL, Application.hwnd) 'DeleteTab Method 139 | Call vtblCall(pTBarList, ITASKLIST3_AddTab, vbLong, CC_STDCALL, Application.hwnd) 'AddTab Method 140 | Call vtblCall(pTBarList, ITASKLIST3_ActivateTab, vbLong, CC_STDCALL, Application.hwnd) 'ActivateTab Method 141 | 142 | If Len(taskcaption) Then 143 | Call vtblCall(pTBarList, ITASKLIST3_Settaskcaption, vbLong, CC_STDCALL, Application.hwnd, StrPtr(taskcaption)) 'Settaskcaption Method 144 | End If 145 | 146 | If Reset Then 147 | Call vtblCall(pTBarList, ITASKLIST3_Settaskcaption, vbLong, CC_STDCALL, Application.hwnd, StrPtr(vbNullString)) 'Settaskcaption Method 148 | End If 149 | 150 | hVbe = FindWindow("wndclass_desked_gsk", vbNullString) 151 | If IsWindowVisible(hVbe) Then 152 | Call SetProp(Application.hwnd, "hVbe", hVbe) 153 | Call ShowWindow(hVbe, 0) 154 | Call vtblCall(pTBarList, ITASKLIST3_DeleteTab, vbLong, CC_STDCALL, hVbe) 'DeleteTab Method 155 | End If 156 | End If 157 | End If 158 | 159 | Call SetForegroundWindow(Application.hwnd): Call BringWindowToTop(Application.hwnd) 160 | 161 | End Sub 162 | 163 | 164 | Private Sub addicon(Optional ByVal Reset As Boolean, Optional ByVal IconGambar As StdPicture, Optional ByVal IconFile As String, Optional ByVal Index As Long = 0) 165 | 166 | #If Win64 Then 167 | Dim hIcon As LongPtr 168 | #Else 169 | Dim hIcon As Long 170 | #End If 171 | 172 | Const WM_SETICON = &H80 173 | Const ICON_SMALL = 0 174 | Const ICON_BIG = 1 175 | 176 | Dim N As Long, S As String 177 | 178 | If Not IconGambar Is Nothing Then 179 | hIcon = IconGambar.Handle 180 | Call SendMessage(Application.hwnd, WM_SETICON, ICON_SMALL, ByVal hIcon) 181 | Call SendMessage(Application.hwnd, WM_SETICON, ICON_BIG, ByVal hIcon) 182 | ElseIf Len(IconFile) Then 183 | If Dir(IconFile, vbNormal) = vbNullString Then 184 | Exit Sub 185 | End If 186 | N = InStrRev(IconFile, ".") 187 | S = LCase(Mid(IconFile, N + 1)) 188 | Select Case S 189 | Case "exe", "ico", "dll" 190 | Case Else 191 | Err.Raise 5 192 | End Select 193 | If Application.hwnd = 0 Then 194 | Exit Sub 195 | End If 196 | 197 | hIcon = ExtractIconA(0, IconFile, Index) 198 | If hIcon <> 0 Then 199 | Call SendMessage(Application.hwnd, WM_SETICON, ICON_SMALL, ByVal hIcon) 200 | Call SendMessage(Application.hwnd, WM_SETICON, ICON_BIG, ByVal hIcon) 201 | End If 202 | 203 | ElseIf Reset Then 204 | hIcon = ExtractIconA(0, Application.Path & "\Excel.exe", 0) 205 | If hIcon <> 0 Then 206 | Call SendMessage(Application.hwnd, WM_SETICON, ICON_SMALL, ByVal hIcon) 207 | Call SendMessage(Application.hwnd, WM_SETICON, ICON_BIG, ByVal hIcon) 208 | End If 209 | End If 210 | 211 | Call DrawMenuBar(Application.hwnd) 212 | DeleteObject hIcon 213 | 214 | End Sub 215 | 216 | 217 | #If Win64 Then 218 | Private Function vtblCall(ByVal InterfacePointer As LongLong, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant 219 | 220 | Dim vParamPtr() As LongLong 221 | #Else 222 | Private Function vtblCall(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant 223 | 224 | Dim vParamPtr() As Long 225 | #End If 226 | 227 | If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function 228 | If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function 229 | 230 | Dim pIndex As Long, pCount As Long 231 | Dim vParamType() As Integer 232 | Dim vRtn As Variant, vParams() As Variant 233 | 234 | vParams() = FunctionParameters() 235 | pCount = Abs(UBound(vParams) - LBound(vParams) + 1&) 236 | If pCount = 0& Then 237 | ReDim vParamPtr(0 To 0) 238 | ReDim vParamType(0 To 0) 239 | Else 240 | ReDim vParamPtr(0 To pCount - 1&) 241 | ReDim vParamType(0 To pCount - 1&) 242 | For pIndex = 0& To pCount - 1& 243 | vParamPtr(pIndex) = VarPtr(vParams(pIndex)) 244 | vParamType(pIndex) = VarType(vParams(pIndex)) 245 | Next 246 | End If 247 | 248 | pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, _ 249 | vParamType(0), vParamPtr(0), vRtn) 250 | If pIndex = 0& Then 251 | vtblCall = vRtn 252 | Else 253 | SetLastError pIndex 254 | End If 255 | 256 | End Function 257 | 258 | 259 | 260 | 261 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Andi Setiadi - Warna Otomatis Hari Libur.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Andi Setiadi - Warna Otomatis Hari Libur.xlsx -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Aplikasi SPP live.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Aplikasi SPP live.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/CRUD Listbox Method List.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/CRUD Listbox Method List.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/CRUD.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/CRUD.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/ContextMenuSheet.bas: -------------------------------------------------------------------------------- 1 | ' --------------------------------------------------------- 2 | '| YouTube Channel : Http://youtube.com/andisetiadii | 3 | ' --------------------------------------------------------- 4 | ' _ _ _ __ _ _ _ _ 5 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 6 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 7 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 8 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 9 | ' 10 | ' Auth : Andi Setiadi 11 | ' Date : 28 Oktober 2021 12 | ' About : Context Menu Sheet 13 | 14 | '===--------------***-----------------=== 15 | ' Simpan di ThisWorkbook Module 16 | '===--------------***-----------------=== 17 | 18 | Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 19 | Dim CmdBtn As CommandBarButton, CmdBtn2 As CommandBarButton 20 | Dim CMenu As CommandBar 21 | Dim Menu2 As CommandBarControl 22 | 23 | On Error Resume Next 24 | Set CMenu = Application.CommandBars("cell") 25 | With CMenu 26 | .Controls("Hari ini").Delete 27 | .Controls("Menu Dua").Delete 28 | Set CmdBtn = .Controls.Add(temporary:=True, before:=1) 29 | Set CmdBtn2 = .Controls.Add(temporary:=True, before:=3) 30 | End With 31 | With CmdBtn 32 | .Caption = "Hari ini" 33 | .FaceId = "125" 34 | .OnAction = "menu_saya" 35 | End With 36 | With CmdBtn2 37 | .Caption = "Subscribe" 38 | .FaceId = "2083" 39 | .OnAction = "SubScribe" 40 | End With 41 | 42 | Set Menu2 = CMenu.Controls.Add(Type:=msoControlPopup, temporary:=True, before:=2) 43 | With Menu2 44 | .Caption = "Menu Dua" 45 | With .Controls.Add 46 | .Caption = "ini Sub Menu" 47 | .FaceId = "23" 48 | .OnAction = "KlikMenu1" 49 | End With 50 | With .Controls.Add 51 | .Caption = "ini Sub Menu 2" 52 | .FaceId = "40" 53 | .OnAction = "KlikMenu2" 54 | End With 55 | End With 56 | End Sub 57 | 58 | '===--------------***-----------------=== 59 | ' Simpan di Module (Standar Module) 60 | '===--------------***-----------------=== 61 | 62 | Public Sub menu_saya() 63 | ActiveCell.Value = Date 64 | End Sub 65 | 66 | Public Sub SubScribe() 67 | ThisWorkbook.FollowHyperlink ("https://www.youtube.com/c/AndiSetiadii?sub_confirmation=1") 68 | End Sub 69 | 70 | Public Sub KlikMenu1() 71 | msgbox "Sub menu 1 di klik" 72 | End Sub 73 | 74 | Public Sub KlikMenu2() 75 | msgbox "Sub menu 2 di klik" 76 | End Sub 77 | 78 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Encode Base64/ImageToBase64.bas: -------------------------------------------------------------------------------- 1 | ' Script ini membutuhkan referensi ADO dan XML 2 | ' Tutorial lengkapnya bisa dilihat di https://youtu.be/dDCF8OIh-lk 3 | 4 | Sub TestBase64() 5 | Dim bytes, Hasil 6 | With CreateObject("ADODB.Stream") 7 | .Open 8 | .Type = ADODB.adTypeBinary 9 | .LoadFromFile "C:\Users\andi\OneDrive\Gambar\ExcelKita\screenshot.png" 10 | bytes = .Read 11 | .Close 12 | End With 13 | Hasil = EncodeBase64(bytes) 14 | 15 | Sheet1.Range("C2").Value = Hasil 16 | 17 | End Sub 18 | 19 | Private Function EncodeBase64(bytes) As String 20 | 21 | Dim objXML As MSXML2.DOMDocument 22 | Dim objNode As MSXML2.IXMLDOMElement 23 | 24 | 25 | Set objXML = New MSXML2.DOMDocument 26 | Set objNode = objXML.createElement("b64") 27 | 28 | objNode.DataType = "bin.base64" 29 | objNode.nodeTypedValue = bytes 30 | EncodeBase64 = objNode.Text 31 | 32 | Set objNode = Nothing 33 | Set objXML = Nothing 34 | End Function 35 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/File Hasil G Meet 18 juni 2023.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/File Hasil G Meet 18 juni 2023.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Form Input Multi Column Combobox.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Form Input Multi Column Combobox.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Game_Control_VBA.bas: -------------------------------------------------------------------------------- 1 | 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 23 November 2020 13 | ' About : Game Control Sederhana 14 | 15 | Dim Obj As Shape 'Deklarasi Global 16 | Dim Gas As Boolean 17 | 18 | Private Sub Worksheet_SelectionChange(ByVal Target As Range) 19 | Set Obj = Shapes("Mobil") 'Deklarasi Object Shape 20 | 21 | If Not Intersect(Target, Range("C2")) Is Nothing Then 'Untuk Maju 22 | If Not Gas Then 23 | Gas = True 24 | Call maju 25 | Else 26 | Gas = False 27 | End If 28 | ElseIf Not Intersect(Target, Range("B3")) Is Nothing Then 'Untuk Belok kiri 29 | Obj.IncrementRotation -10 30 | ElseIf Not Intersect(Target, Range("D3")) Is Nothing Then 'Untuk Belok Kanan 31 | Obj.IncrementRotation 10 32 | ElseIf Not Intersect(Target, Range("C4")) Is Nothing Then 'Untuk Mundur 33 | If Not Gas Then 34 | Gas = True 35 | Call Mundur 36 | Else 37 | Gas = False 38 | End If 39 | End If 40 | Range("C3").Select 41 | End Sub 42 | 43 | Sub Maju() 44 | GasMaju: 45 | If Obj.Rotation >= 0 And Obj.Rotation < 180 Then 46 | If Obj.Rotation = 90 Then 47 | Obj.IncrementLeft 3 48 | Else 49 | Obj.IncrementLeft ((90 - Abs(90 - Obj.Rotation)) / 30) 50 | End If 51 | Else 52 | If Obj.Rotation = 270 Then 53 | Obj.IncrementLeft -3 54 | Else 55 | Obj.IncrementLeft -((90 - Abs(270 - Obj.Rotation)) / 30) 56 | End If 57 | End If 58 | 59 | If Obj.Rotation > 270 And Obj.Rotation < 90 Then 60 | If Obj.Rotation = 0 Then 61 | Obj.IncrementTop -3 62 | Else 63 | If Obj.Rotation < 90 Then 64 | Obj.IncrementTop -((90 - Abs(0 - Obj.Rotation)) / 30) 65 | Else 66 | Obj.IncrementTop -((90 - Abs(360 - Obj.Rotation)) / 30) 67 | End If 68 | End If 69 | Else 70 | If Obj.Rotation = 180 Then 71 | Obj.IncrementTop 3 72 | Else 73 | Obj.IncrementTop ((90 - Abs(180 - Obj.Rotation)) / 30) 74 | End If 75 | End If 76 | If Not Gas Then Exit Sub 77 | For i = 1 To 7000000: Next 78 | DoEvents 79 | GoTo GasMaju 80 | End Sub 81 | 82 | Sub Mundur() 83 | GasMundur: 84 | If Obj.Rotation >= 0 And Obj.Rotation < 180 Then 85 | If Obj.Rotation = 90 Then 86 | Obj.IncrementLeft -3 87 | Else 88 | Obj.IncrementLeft -((90 - Abs(90 - Obj.Rotation)) / 30) 89 | End If 90 | Else 91 | If Obj.Rotation = 270 Then 92 | Obj.IncrementLeft 3 93 | Else 94 | Obj.IncrementLeft ((90 - Abs(270 - Obj.Rotation)) / 30) 95 | End If 96 | End If 97 | 98 | If Obj.Rotation > 270 And Obj.Rotation < 90 Then 99 | If Obj.Rotation = 0 Then 100 | Obj.IncrementTop 3 101 | Else 102 | If Obj.Rotation < 90 Then 103 | Obj.IncrementTop ((90 - Abs(0 - Obj.Rotation)) / 30) 104 | Else 105 | Obj.IncrementTop ((90 - Abs(360 - Obj.Rotation)) / 30) 106 | End If 107 | End If 108 | Else 109 | If Obj.Rotation = 180 Then 110 | Obj.IncrementTop -3 111 | Else 112 | Obj.IncrementTop -((90 - Abs(180 - Obj.Rotation)) / 30) 113 | End If 114 | End If 115 | If Not Gas Then Exit Sub 116 | For i = 1 To 7000000: Next 117 | DoEvents 118 | GoTo GasMundur 119 | End Sub 120 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Jadwal Shalat.bas: -------------------------------------------------------------------------------- 1 | 'Fungsi Untuk Parse JSON 2 | '------------------------------------------------------------------ 3 | Function GetJadwal(tanggal as string) As Dictionary 4 | Dim objHTTP As Object 5 | 6 | Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") 7 | URL = "https://api.pray.zone/v2/times/day.json?city=tasikmalaya&date=" & tanggal 8 | 9 | objHTTP.Open "GET", URL, False 10 | objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" 11 | objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded" 12 | objHTTP.Send 13 | 14 | Dim JSON As Object 15 | Set JSON = JsonConverter.ParseJson(objHTTP.responseText) 16 | Set GetJadwal = JSON("results")("datetime")(1)("times") 17 | End Function 18 | 19 | 20 | 'UserForm1 Module 21 | '------------------------------------------------------------------ 22 | Private Sub UserForm_Initialize() 23 | Dim Jadwal As New Dictionary 24 | 25 | Set Jadwal = GetJadwal(format(date, "YYYY-MM-DD")) 26 | LBImsak = Jadwal("Imsak") 27 | LBShubuh = Jadwal("Fajr") 28 | LBDzuhur = Jadwal("Dhuhr") 29 | LBAshar = Jadwal("Asr") 30 | LBMaghrib = Jadwal("Maghrib") 31 | LbIsya = Jadwal("Isha") 32 | End Sub 33 | 34 | 35 | Private Sub UserForm_Activate() 36 | Berhenti = False 37 | Do Until Berhenti 38 | LBJam.Caption = Format(Time, "hh:mm:ss am/pm") 39 | LBTanggal.Caption = WorksheetFunction.Text(Date, "[$-0421] DDDD, DD MMMM YYYY") 40 | DoEvents 41 | Loop 42 | End Sub 43 | 44 | Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 45 | Berhenti = True 46 | End Sub 47 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Kirim Email GMail dari Excel.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 11 September 2020 13 | ' About : Kirim Email dengan Akun Gmail dari Ms. Excel 14 | 15 | Sub KirimGmail() 16 | Dim CDO_Mail As Object 17 | Dim CDO_Config As Object 18 | Dim SMTP_Config As Variant 19 | Dim Schema As String 20 | 21 | On Error GoTo kesalahan 22 | Set CDO_Mail = CreateObject("CDO.Message") 23 | Set CDO_Config = CreateObject("CDO.configuration") 24 | CDO_Config.Load -1 25 | 26 | Set SMTP_Config = CDO_Config.Fields 27 | Schema = "http://schemas.microsoft.com/cdo/configuration/" 28 | 29 | With SMTP_Config 30 | .Item(Schema & "sendusing") = 2 'untuk port 31 | .Item(Schema & "smtpserver") = "smtp.gmail.com" 32 | .Item(Schema & "smtpserverport") = 465 33 | .Item(Schema & "smtpauthenticate") = 1 34 | .Item(Schema & "sendusername") = "xxxxxx@gmail.com" 'diisi dengan Alamat Email Gmail 35 | .Item(Schema & "sendpassword") = "password" 'diisi dengan Password Gmail 36 | .Item(Schema & "smtpusessl") = True 37 | .Update 38 | End With 39 | 40 | With CDO_Mail 41 | .configuration = CDO_Config 42 | 43 | .Subject = "Kirim Dari Excel" 44 | .From = "xxxxxx@gmail.com" 'diisi dengan Alamat Email Gmail 45 | .to = "email@tujuan.com" 'diisi dengan email tujuan 46 | .CC = "" 47 | .bcc = "" 48 | .textbody = "Hallo, email ini dikirim dari Excel" 'Isi Pesan 49 | .send 50 | End With 51 | Exit Sub 52 | 53 | kesalahan: 54 | If Err.Description <> "" Then MsgBox Err.Description 55 | End Sub 56 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Kirim Email Outlook (Early Binding).bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 21 September 2020 13 | ' About : Kirim Email dengan Outlook dari Ms. Excel 14 | ' 15 | ' # Early Binding => silahkan tambahkan Microsoft Outlook Object Library Pada References 16 | ' 17 | 18 | Sub KirimEmail() 19 | Dim Outl As Outlook.Application 20 | Dim Msg As Outlook.MailItem 21 | 22 | On Error GoTo kesalahan 23 | 24 | Set Outl = New Outlook.Application 25 | Set Msg = Outl.CreateItem(0) 26 | 27 | With Msg 28 | .To = Sheet1.Range("C2").Value 29 | .cc = Sheet1.Range("C3").Value 30 | .bcc = Sheet1.Range("C4").Value 31 | .Subject = Sheet1.Range("C5").Value 32 | .Attachments.add "LokasiFile" 33 | .Body = Sheet1.Range("C6").Value 34 | .send 35 | End With 36 | 37 | MsgBox "Email Sudah Berhasil terkirim" 38 | Exit Sub 39 | 40 | kesalahan: 41 | MsgBox "Email Gagal dikirim " & vbNewLine & "Error :" & Err.Description 42 | 43 | End Sub 44 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Kirim Email Outlook (Late Binding).bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 21 September 2020 13 | ' About : Kirim Email dengan Outlook dari Ms. Excel 14 | 15 | Sub KirimEmail() 16 | Dim Outl As Object 'Deklarasi Object 17 | Dim Msg As Object 18 | 19 | 'Set Object Outlook 20 | Set Outl = CreateObject("Outlook.Application") 21 | Set Msg = Outl.CreateItem(0) 22 | 23 | ' isi Item 24 | With Msg 25 | .To = Sheet1.Range("B2").Value 26 | .CC = Sheet1.Range("B3").Value 27 | .bcc = Sheet1.Range("B4").Value 28 | .Subject = Sheet1.Range("B5").Value 29 | .Body = Sheet1.Range("B6").Value 30 | .Attachments.Add "lokasiFile" 'jika ada 31 | .Send 32 | End with 33 | End Sub 34 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Maximize_Minimize_API.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 14 Juli 2021 13 | ' About : 14 | ' 15 | ' Cara Penggunaan 16 | ' 1. Simpan API dan Function SetMaxMin ke dalam Module 17 | ' 2. Pada Userform yang ingin ditambahkan Max dan Min tambhakan pada Initialize script 18 | ' SetMaxMin Me.caption 19 | 20 | 21 | #If VBA7 And Win64 Then 22 | '64 bit 23 | Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias _ 24 | "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 25 | Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias _ 26 | "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 27 | Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias _ 28 | "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 29 | #Else 30 | '32bit 31 | Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _ 32 | (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 33 | Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _ 34 | (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 35 | Private Declare Function GetWindowLong Lib "user32.dll" Alias _ 36 | "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 37 | #End If 38 | 39 | Private Const GWL_STYLE = -16 40 | Private Const WS_MAXIMIZEBOX = &H10000 41 | Private Const WS_MINIMIZEBOX = &H20000 42 | 43 | Function SetMaxMin(xCaption As String) 44 | Dim hwnd As Long 45 | Dim stylelama As Long 46 | 47 | hwnd = FindWindow("ThunderDFrame", xCaption) 48 | stylelama = GetWindowLong(hwnd, GWL_STYLE) 49 | SetWindowLong hwnd, GWL_STYLE, stylelama Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX 50 | End Function 51 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Membuat Banyak Sheet.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 13 Oktober 2020 13 | ' About : Membuat Banyak Sheet dengan Nama dari Range 14 | 15 | Sub BuatSheet() 16 | Dim ArrSheet As Variant 17 | Dim Baris As Long 18 | Dim Sht as Variant 19 | 20 | Baris = Sheet1.Range("A1").End(xlDown).Row 'Menghitung Baris Akhir 21 | ArrSheet = Application.Transpose(Sheet1.Range("A2:A" & Baris)) 'Array Nama Sheet yang akan dibuat 22 | For Each Sht In ArrSheet 'Looping Array 23 | If CheckSheet(Sht) Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = Sht 24 | Next 25 | End Sub 26 | 27 | Function CheckSheet(Sht As Variant) As Boolean 'Fungsi Untuk Mengecek Nama Sheet sudah digunakan atau belum 28 | Dim Sh As Worksheet 29 | On Error Resume Next 30 | Set Sh = Sheets(Sht) 'jika ada akan menjadi object Sh jika belum ada akan Error (Object Nothing) 31 | CheckSheet = Sh Is Nothing 32 | Err.Clear 33 | End Function 34 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/PlaceHolderVBA.bas: -------------------------------------------------------------------------------- 1 | 'Isi PlaceHolder Text 2 | '------------------------------------------------------- 3 | Public Sub PlaceHolder() 4 | TBCustomer.Tag = "Isi Customer..." 5 | TBPic.Tag = "Isi PIC..." 6 | TBmanID.Tag = "Isi ID..." 7 | TBManDate.Tag = "Isi Tanggal..." 8 | End Sub 9 | 10 | Public Sub PH_Enter(Ctrl As MSForms.TextBox) 11 | If Ctrl.Value = Ctrl.Tag Then 12 | Ctrl.Value = "" 13 | Ctrl.ForeColor = vbWhite 14 | End If 15 | End Sub 16 | 17 | Public Sub PH_Exit(Ctrl As MSForms.TextBox) 18 | If Len(Ctrl.Value) = 0 Then 19 | Ctrl.Value = Ctrl.Tag 20 | Ctrl.ForeColor = &HB88A5F 21 | End If 22 | End Sub 23 | 24 | 'Penggunaan 25 | '------------------------------------------ 26 | 27 | Private Sub TBCustomer_Enter() 28 | PH_Enter TBCustomer 29 | End Sub 30 | 31 | Private Sub TBCustomer_Exit(ByVal Cancel As MSForms.ReturnBoolean) 32 | PH_Exit TBCustomer 33 | End Sub 34 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | ###### YouTube Channel: https://youtube.com/andisetiadii 4 | ----- 5 | Berisi file pendukung dari YouTube Tutorial - Playlist > VBA Tips & Trick 6 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - Aplikasi Jadwal Shalat.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - Aplikasi Jadwal Shalat.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - ImageCombobox.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - ImageCombobox.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - Menampilkan PDF di UserForm.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - Menampilkan PDF di UserForm.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - Menghitung Data Unik.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - Menghitung Data Unik.xlsx -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - Userform Always On Top.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - Userform Always On Top.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - VBA Fun Hujan.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - VBA Fun Hujan.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/Setiadi.my.id - VBA Google & Youtube Search.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/Setiadi.my.id - VBA Google & Youtube Search.xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/ShortcutShiftF3Excel.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Author : Andi Setiadi 12 | ' Update : 10 Oktober 2021 13 | ' About : Shortcut Shift + F3 Override 14 | ' 15 | ' Cara Penggunaan 16 | ' 1. Simpan Script ke Masing-Masing Module 17 | ' 2. Tutup dan buka kembali Excel untuk mendapatkan effect 18 | 19 | '--------------------------------------------------------- 20 | 'Override Default SHift + F3 Excel 21 | 'Simpan di ThisWorkbook Module 22 | '--------------------------------------------------------- 23 | Private Sub Workbook_Open() 24 | Application.OnKey "+{F3}", "GantiCase" 25 | End Sub 26 | 27 | 28 | '--------------------------------------------------------- 29 | 'Simpan Dalam Standar Module 30 | '--------------------------------------------------------- 31 | Public Sub GantiCase() 32 | Dim Ch1 As String 33 | Dim Ch2 As String 34 | 35 | Ch1 = Left(Selection(1, 1).Value, 1) 36 | Ch2 = Mid(Selection(1, 1).Value, 2, 1) 37 | 38 | For Each cell In Selection 39 | If Asc(Ch1) < 91 And Asc(Ch2) < 91 Then 40 | cell.Value = LCase(cell.Value) 41 | ElseIf Asc(Ch1) > 91 And Asc(Ch2) > 91 Then 42 | cell.Value = StrConv(cell.Value, vbProperCase) 43 | Else 44 | cell.Value = UCase(cell.Value) 45 | End If 46 | Next cell 47 | End Sub 48 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/UploadFileFTP.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Auth : Andi Setiadi 12 | ' Date : 28 Oktober 2020 13 | ' About : Upload File ke web Melalui FTP 14 | 15 | Private Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0 16 | Private Const INTERNET_FLAG_RELOAD As Long = &H80000000 17 | 18 | Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _ 19 | ByVal lpszAgent As String, _ 20 | ByVal dwAccessType As Long, _ 21 | ByVal lpszProxy As String, _ 22 | ByVal lpszProxyBypass As String, _ 23 | ByVal dwFlags As Long) As Long 24 | 25 | Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _ 26 | ByVal hInternet As Long, _ 27 | ByVal lpszServerName As String, _ 28 | ByVal nServerPort As Long, _ 29 | ByVal lpszUserName As String, _ 30 | ByVal lpszPassword As String, _ 31 | ByVal dwService As Long, _ 32 | ByVal dwFlags As Long, _ 33 | ByVal dwContext As Long) As Long 34 | 35 | Private Declare Function FtpPutFileA _ 36 | Lib "wininet.dll" _ 37 | (ByVal hFtpSession As Long, _ 38 | ByVal lpszLocalFile As String, _ 39 | ByVal lpszRemoteFile As String, _ 40 | ByVal dwFlags As Long, _ 41 | ByVal dwContext As Long) As Boolean 42 | 43 | Private Declare Function InternetCloseHandle Lib "wininet" ( _ 44 | ByVal hInet As Long) As Long 45 | 46 | Sub FtpUpload(ByVal strLocalFile As String, ByVal strRemoteFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String) 47 | Dim Status As Boolean 48 | Dim hOpen As Long 49 | Dim hConn As Long 50 | 51 | hOpen = InternetOpen("FTPGET", 1, vbNullString, vbNullString, 1) 52 | hConn = InternetConnect(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2) 53 | Status = FtpPutFileA(hConn, strLocalFile, strRemoteFile, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) 54 | If Status Then 55 | Debug.Print "Upload Success" 56 | Else 57 | Debug.Print "Upload Fail" 58 | End If 59 | 60 | 'Close connections 61 | InternetCloseHandle hConn 62 | InternetCloseHandle hOpen 63 | 64 | End Sub 65 | 66 | 'Pengunaaan 67 | '-------------------- 68 | Sub TestUpload() 69 | FtpUpload "C:\LokadiFile\Nama Fiile.txt", "//Download/Nama file.txt", _ 70 | "192.168.0.100", 21, "username", "password" 71 | End Sub 72 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/VBA CalendarForm/CalendarForm.rar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/VBA CalendarForm/CalendarForm.rar -------------------------------------------------------------------------------- /VBA Tips & Trick Files/VBA CalendarForm/readme.md: -------------------------------------------------------------------------------- 1 | # Calendar Form 2 | 3 | ## File: 4 | Download CalendarForm.rar 5 | 6 | ## Worksheet Script: 7 | ```vb 8 | 9 | Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 10 | Dim Tanggal As Date 11 | 12 | If Not Intersect(Target, Range("C2:C20")) Is Nothing Then 13 | Tanggal = CalendarForm.GetDate 14 | If Not Tanggal = Empty Then 15 | Target = Tanggal 16 | End If 17 | End If 18 | End Sub 19 | ``` 20 | 21 | ## Function Script: 22 | ```vb 23 | Function GetTanggal(Ctr as Control) 24 | Dim Tanggal As Date 25 | 26 | Tanggal = CalendarForm.GetDate 27 | If Not Tanggal = Empty Then 28 | Ctr.Text = Tanggal 29 | End If 30 | End Sub 31 | ``` 32 | 33 | ## Penggunaan: 34 | ```vb 35 | GetTanggal Textbox1.Text 36 | ``` 37 | 38 | ### Lihat di YouTube 39 | [![IMAGE ALT TEXT HERE](https://img.youtube.com/vi/rsv7L0TGSyI/0.jpg)](https://youtu.be/rsv7L0TGSyI) 40 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/VBAPushNotification.bas: -------------------------------------------------------------------------------- 1 | Sub SHKirim_Click() 2 | Dim KirimJson As String 3 | Dim title As String 4 | Dim body As String 5 | Dim request As Object 6 | Dim URL As String, Token As String 7 | 8 | URL = "https://api.pushbullet.com/v2/pushes" 9 | Token = "Token" 10 | 11 | title = Sheet1.Range("D3").Value 12 | body = Sheet1.Range("D4").Value 13 | 14 | KirimJson = "{""type"":""note"",""title"":""" & title & """,""body"":""" & body & """}" 15 | 16 | Set request = CreateObject("MSXML2.XMLHTTP") 17 | 18 | request.Open "POST", URL, False 19 | 20 | request.setrequestheader "Autorization", "Bearer " & Token 21 | request.setrequestheader "Content-type", "application/json" 22 | 23 | request.send (KirimJson) 24 | 25 | End Sub 26 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/VBAUserformTransparent.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' --------------------------------------------------------- 3 | '| YouTube Channel : Http://youtube.com/andisetiadii | 4 | ' --------------------------------------------------------- 5 | ' _ _ _ __ _ _ _ _ 6 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 7 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 8 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 9 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 10 | ' 11 | ' Author : Andi Setiadi 12 | ' Update : 10 Oktober 2021 13 | ' About : Transparent Userform 14 | ' 15 | ' Cara Penggunaan 16 | ' 1. Simpan script Module 17 | ' 2. untuk penggunaanya panggil BuatTransparent me.caption 18 | ' 19 | 20 | #If Win64 And VBA7 Then 21 | Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32.dll" _ 22 | (ByVal hwnd As Long, _ 23 | ByVal crKey As Long, _ 24 | ByVal bAlpha As Byte, _ 25 | ByVal dwFlags As Long) As Long 26 | 27 | Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias _ 28 | "FindWindowA" (ByVal lpClassName As String, _ 29 | ByVal lpWindowName As String) As Long 30 | 31 | Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias _ 32 | "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _ 33 | ByVal dwNewLong As Long) As Long 34 | 35 | Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias _ 36 | "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 37 | #Else 38 | '32 Bit 39 | Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" _ 40 | (ByVal hwnd As Long, _ 41 | ByVal crKey As Long, _ 42 | ByVal bAlpha As Byte, _ 43 | ByVal dwFlags As Long) As Long 44 | 45 | Private Declare Function FindWindow Lib "user32.dll" Alias _ 46 | "FindWindowA" (ByVal lpClassName As String, _ 47 | ByVal lpWindowName As String) As Long 48 | 49 | Private Declare Function SetWindowLong Lib "user32.dll" Alias _ 50 | "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _ 51 | ByVal dwNewLong As Long) As Long 52 | 53 | Private Declare Function GetWindowLong Lib "user32.dll" Alias _ 54 | "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 55 | #End If 56 | 57 | 58 | Private Const LWA_ALPHA = &H2 59 | Private Const LWA_COLORKEY = &H1 60 | Private Const GWL_EXSTYLE = -20 61 | Private Const WS_EX_LAYERED = &H80000 62 | 63 | Public Sub BuatTransparent(xCaption As String) 64 | Dim hwnd As Long 65 | Dim SStyle As Long 66 | 67 | hwnd = FindWindow("ThunderDFrame", xCaption) 68 | SStyle = GetWindowLong(hwnd, GWL_EXSTYLE) 69 | SetWindowLong hwnd, GWL_EXSTYLE, SStyle Or WS_EX_LAYERED 70 | SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA 71 | End Sub 72 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/andi setiadi - FilterXML.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/andi setiadi - FilterXML.xlsx -------------------------------------------------------------------------------- /VBA Tips & Trick Files/coba.hta: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 9 | 10 | Youtube Andi Setiadi 11 | 34 | 35 | 36 | 37 |

Kamu siapa?

38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/comboboxunik.bas: -------------------------------------------------------------------------------- 1 | Private Sub UserForm_Initialize() 2 | Rem Author : Andi Setiadi 3 | Dim Datanya As Range 4 | Dim Baris As Long 5 | Dim Kamus As Object 6 | 7 | Baris = Sheet1.Range("D" & Rows.Count).End(xlUp).Row 8 | Set Kamus = CreateObject("Scripting.Dictionary") 9 | Set Datanya = Range("D10:D" & Baris) 10 | 11 | For Each isi In Datanya 12 | If Not Kamus.exists(LCase(isi.Value)) Then 13 | ComboBox1.AddItem isi.Value 14 | Kamus.Add LCase(isi.Value), isi.Value 15 | End If 16 | Next isi 17 | End Sub 18 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/highlightCell.bas: -------------------------------------------------------------------------------- 1 | ' --------------------------------------------------------- 2 | '| YouTube Channel : Http://youtube.com/andisetiadii | 3 | ' --------------------------------------------------------- 4 | ' _ _ _ __ _ _ _ _ 5 | ' /_\ _ __ __| (_) / _\ ___| |_(_) __ _ __| (_) 6 | ' //_\\| '_ \ / _` | | \ \ / _ \ __| |/ _` |/ _` | | 7 | '/ _ \ | | | (_| | | _\ \ __/ |_| | (_| | (_| | | 8 | '\_/ \_/_| |_|\__,_|_| \__/\___|\__|_|\__,_|\__,_|_| 9 | ' 10 | ' Auth : Andi Setiadi 11 | ' Date : 30 Oktober 2021 12 | ' About : Hightlight Cell 13 | 14 | '===--------------***-----------------=== 15 | ' Simpan di Sheet Module 16 | '===--------------***-----------------=== 17 | 18 | Private Sub Worksheet_SelectionChange(ByVal Target As Range) 19 | Dim Areanya As Range 20 | Dim Brs As Long, Kol As Long 21 | 22 | Set Areanya = Range("B2:Q21") 23 | 24 | 25 | If Not Intersect(Target, Areanya) Is Nothing Then 26 | 27 | Brs = Target.Row 28 | Kol = Target.Column 29 | 30 | Range("A2:A21").Interior.Color = 6299648 31 | Range("B1:Q1").Interior.Color = 6299648 32 | 33 | Areanya.Interior.ColorIndex = 0 34 | Range(Cells(2, Kol), Cells(21, Kol)).Interior.Color = 16750848 35 | Range(Cells(Brs, 2), Cells(Brs, "Q")).Interior.Color = 16763904 36 | 37 | Cells(1, Kol).Interior.Color = 49407 38 | Cells(Brs, 1).Interior.Color = 49407 39 | Target.Interior.Color = vbYellow 40 | End If 41 | End Sub 42 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/joinIF.bas: -------------------------------------------------------------------------------- 1 | Function JOINIF(CriteriaRange As Range, _ 2 | Criteria As Variant, _ 3 | GabungRange As Range, _ 4 | Optional Delimiter As String = ",") As Variant 5 | 6 | Dim j As Long 7 | Dim TempString As String: TempString = "" 8 | 9 | On Error GoTo Kesalahan 10 | 11 | If CriteriaRange.Count <> GabungRange.Count Then 12 | JOINIF = CVErr(xlErrRef) 13 | Exit Function 14 | End If 15 | 16 | For j = 1 To CriteriaRange.Count 17 | If CriteriaRange.Cells(j).Value = Criteria Then 18 | TempString = TempString & Delimiter & GabungRange.Cells(j).Value 19 | End If 20 | Next j 21 | 22 | If Not TempString = "" Then 23 | TempString = Mid(TempString, Len(Delimiter) + 1) 24 | End If 25 | 26 | JOINIF = TempString 27 | Exit Function 28 | 29 | Kesalahan: 30 | JOINIF = CVErr(xlErrValue) 31 | 32 | End Function 33 | -------------------------------------------------------------------------------- /VBA Tips & Trick Files/setiadi.my.id - Multi Sheet 1 file PDF .xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/setiadi.my.id - Multi Sheet 1 file PDF .xlsm -------------------------------------------------------------------------------- /VBA Tips & Trick Files/setiadi.my.id - Text Berjalan dan Jam Berjalan.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/VBA Tips & Trick Files/setiadi.my.id - Text Berjalan dan Jam Berjalan.xlsm -------------------------------------------------------------------------------- /images/Andi Setiadi.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ba5tz/vbaTutorial/f87f07d2029823c2e3585bac980937939e780531/images/Andi Setiadi.png -------------------------------------------------------------------------------- /images/file.md: -------------------------------------------------------------------------------- 1 | 2 | --------------------------------------------------------------------------------