Một số code VBA Excel ứng dụng

1. Tạo nút phóng to, thu nhỏ userform



- Tạo 1 modun

Option Explicit
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Public Const GWL_STYLE As Long = (-16)        'Sets a new window style
Public Const WS_SYSMENU As Long = &H80000        'Windows style
Public Const WS_MINIMIZEBOX As Long = &H20000
Public Const WS_MAXIMIZEBOX As Long = &H10000
Public Const SW_SHOWMAXIMIZED = 3
Public lFormHandle  As Long, lStyle As Long

Sub TombolMinMax(UserFormCaption As String)
    lFormHandle = FindWindow("ThunderDFrame", UserFormCaption)
    lStyle = GetWindowLong(lFormHandle, GWL_STYLE)
    lStyle = lStyle Or WS_SYSMENU        'SystemMenu
    lStyle = lStyle Or WS_MINIMIZEBOX        'With MinimizeBox
    lStyle = lStyle Or WS_MAXIMIZEBOX        'and MaximizeBox
    
    SetWindowLong lFormHandle, GWL_STYLE, (lStyle)
    DrawMenuBar lFormHandle
End Sub

- Sau đó chèn vào Private Sub UserForm_Initialize()

TombolMinMax (Me.Caption)

2.  Tạo chế độ full màn hình cho userform: chèn vào Private Sub UserForm_Initialize()

* Tỷ lệ tùy bạn, hay thay 94 thành số phù hợp

With Application
    .WindowState = xlMaximized
    Zoom = Int(.Width / Me.Width * 94)
    Zoom = Int(.Height / Me.Height * 94)
    Width = .Width
    Height = .Height
End With

3. Tự động sao lưu


'---auto backup---
Sub Auto_Save()
    Dim saveDate    As Date
    Dim saveTime    As Variant
    Dim formatTime  As String
    Dim formatDate  As String
    Dim backupFolder As String
    
    saveDate = Date
    saveTime = Time
    
    formatTime = Format(saveTime, "hh.MM.ss")
    formatDate = Format(saveDate, "DD - MM - YYYY")
    
    Application.DisplayAlerts = FALSE
    backupFolder = ThisWorkbook.Path & "\"
    ActiveWorkbook.SaveCopyAs Filename:=backupFolder & Replace(ActiveWorkbook.Name, ".xlsm", "") & " " & formatDate & " " & formatTime & ".xlsm"
    Application.DisplayAlerts = TRUE
    CreateObject("WScript.Shell").Popup "Sao l" & ChrW(432) & "u th" & ChrW(224) & "nh c" & ChrW(244) & "ng! " & backupFolder, , "TH" & ChrW(212) & "NG TIN SAO L" & ChrW(431) & "U", 0 + 64
    '------end sao luu-----
Bản quyền bài viết: saunguyen.pro
Bài viết liên quan:

Đăng nhận xét

Để lại bình luận ở đây😘