Option Explicit
Private Const HCBT_ACTIVATE = 5
Private Const WM_SETFONT = &H30
Private Const FONT_FACE = "Tahoma"
Public Const SWP_HiDEWiNDOW = &H80
Public Declare Function GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadid" () As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal h As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, ByVal w As Long, ByVal i As Long, ByVal U As Long, ByVal S As Long, ByVal c As Long, ByVal OP As Long, ByVal CP As Long, ByVal q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowTextW Lib "user32" (ByVal hwnd As Long, ByVal lpString As Long) As Long
Private Declare Function SetTimer& Lib "user32" (ByVal hwnd&, ByVal niDEvent&, ByVal uElapse&, ByVal lpTimerFunc&)
Private Declare Function KillTimer& Lib "user32" (ByVal hwnd&, ByVal niDEvent&)
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFiLENAME) As Long
Public m_DialogTitle As String
Public hDialogHook As Long
Public sFileName As String
Private Type OPENFiLENAME
lStructSize As Long
hwndOwner As Long
hinstance As Long
lpstrFilter As Long
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterindex As Long
lpstrFile As Long
nMaxFile As Long
lpstrFileTitle As Long
nMaxFileTitle As Long
lpstrinitialDir As Long
lpstrTitle As Long
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Enum OpenSaveflags
OFN_ALLOWMULTiSELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_ENABLESiZiNG = &H800000
OFN_EXTENSiONDiFFERENT = &H400
OFN_FiLEMUSTEXiST = &H1000
OFN_HiDEREADONLY = &H4
OFN_NOCHANGEDiR = &H8
OFN_NODEREFERENCELiNKS = &H100000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_OVERWRiTEPROMPT = &H2
OFN_PATHMUSTEXiST = &H800
OFN_READONLY = &H1
OFN_SHOWHELP = &H10
OFN_ENABLEHOOK = &H20&
OFN_EXPLORER = &H80000
End Enum
Private Const WH_CBT = 5
Public Function ShowOpen(Optional ByRef m_FileNameinit As String = "", Optional m_initDir As String = "", Optional ByRef m_Filter As String = "", Optional ByVal m_Filterindex As Long = 1, Optional ByVal m_def_DefaultExt As String = "", Optional ByVal m_MaxFileSize As Long = 10000, Optional ByVal hOwner As Long = 0, Optional ByVal m_Flags As OpenSaveflags = OFN_EXPLORER) As Boolean
On Error GoTo Err
Dim OFName As OPENFiLENAME, sTemp As String
With OFName
.lStructSize = Len(OFName)
.flags = m_Flags
.hwndOwner = hOwner
.lpstrDefExt = StrPtr(m_def_DefaultExt)
Dim file As String
If m_MaxFileSize <= 0 Then m_MaxFileSize = 20000
sTemp = String(m_MaxFileSize - Len(m_FileNameinit), vbNullChar)
m_FileNameinit = m_FileNameinit & sTemp
.lpstrFile = StrPtr(m_FileNameinit)
If Len(m_Filter) <= 0 Then m_Filter = "All files|*.*"
m_Filter = Replace(m_Filter, "|", vbNullChar) & vbNullChar & vbNullChar
.lpstrFilter = StrPtr(m_Filter)
m_initDir = m_initDir
.lpstrinitialDir = StrPtr(m_initDir)
If Len(m_DialogTitle) <= 0 Then m_DialogTitle = "Select a file(s)"
.lpstrTitle = StrPtr(m_DialogTitle)
.nFilterindex = m_Filterindex
.nMaxFile = m_MaxFileSize
.nMaxFileTitle = 260
.lpstrDefExt = StrPtr(m_def_DefaultExt)
If GetOpenFileName(OFName) Then
While Right(m_FileNameinit, 1) = vbNullChar
m_FileNameinit = Left(m_FileNameinit, Len(m_FileNameinit) - 1)
Wend
m_FileNameinit = Replace(m_FileNameinit, vbNullChar, "|")
ShowOpen = True
Else
m_FileNameinit = ""
ShowOpen = False
End If
End With
Exit Function
Err:
MsgBox Err.Description, , Err.Number
End Function
Sub GhepExcelFile(Control As IRibbonControl)
Dim sFileName As String
Dim ArrFile() As String
Dim i As Integer
Dim DirLog As String
Dim MaxCol As Long
Dim MaxRow As Long
Dim bHeader As Boolean
Dim OutputFile As String
bHeader = False
If ShowOpen(sFileName, , "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx", , , , , OFN_ALLOWMULTiSELECT Or OFN_EXPLORER) = True Then
ArrFile = Split(sFileName, "|")
DirLog = ArrFile(LBound(ArrFile)) & "\"
If UBound(ArrFile) > 0 Then
OutputFile = "Tong hop " & Format(Now(), "ddmmyyyy hhmmss") & ".xlsx"
Workbooks.Add
ChDir DirLog
ActiveWorkbook.SaveAs Filename:=DirLog & OutputFile
For i = LBound(ArrFile) + 1 To UBound(ArrFile)
Workbooks.Open DirLog & ArrFile(i)
MaxRow = ActiveSheet.UsedRange.Rows.Count
MaxCol = ActiveSheet.UsedRange.Columns.Count
If bHeader = False Then
Range(Cells(1, 1).Address & ":" & Cells(MaxRow, MaxCol).Address).Select
bHeader = True
Else
Range(Cells(2, 1).Address & ":" & Cells(MaxRow, MaxCol).Address).Select
End If
Selection.Copy
Windows(OutputFile).Activate
MaxRow = ActiveSheet.UsedRange.Rows.Count
If MaxRow = 1 Then
Range("A1").Select
Else
Range("A" & (MaxRow + 1)).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(ArrFile(i)).Close
Next i
Range("B2").Select
ActiveWindow.FreezePanes = True
ActiveWorkbook.Save
End If
End If
End Sub
