Sub Insert_HS()
Dim vraag As Variant
Dim sh As Worksheet
Dim wkbTarget As Workbook, wkbSource As Workbook
Dim i, arrNames, sFile As String
On Error GoTo QuitOpen
ActiveWorkbook.Activate
If ActiveWorkbook.FileFormat = 56 Then
MsgboxUni UNC("V× ActiveWorkbook lµ mét tÖp Excel 97-2003 nªn kh«ng thÓ chÌn Template vµo ®îc" & vbNewLine & _
"H·y chuyÓn ®æi ®Þnh d¹ng File sang d¹ng Office cao h¬n (VD: .xlsx, .xlsm, .xlsb)"), 64, UNC("Thong Bao")
Else
If ActiveWorkbook.ProtectStructure = True Then
MsgboxUni UNC("V× ActiveWorkbook ®ang ®îc b¶o vÖ nªn kh«ng thÓ chÌn Template vµo ®îc" & vbNewLine & _
"Xin vui lßng bá chÕ ®é b¶o vÖ vµ thùc hiÖn l¹i!!!!."), 64, UNC("Thong Bao")
Else
vraag = MsgboxUni(UNC("B¹n cã muèn chÌn Template vµo Workbook b¹n ®ang lµm viÖc kh«ng ?"), vbYesNo, "Thong Bao")
If vraag = vbNo Then Exit Sub
'Chen Shet vao File
Call TangTocCode(True)
Set wkbTarget = ActiveWorkbook
sFile = GetRegistry(HKEY_SET, "lbPath_HC")
If sFile <> "" Then
Set wkbSource = Workbooks.Open(sFile)
Else
MsgboxUni UNC("§êng dÉn ®Õn File cha ®îc thiÕt lËp! Vui lßng vµo phÇn CÊu h×nh ®Ó thùc hiÖn"), 64, UNC("Thong Bao")
Exit Sub
End If
If KiemtraSheet("Thongtin_CT") = False And KiemtraSheet("DS_DoiTac") = False Then
arrNames = VBA.Array("TEMP", "Input_TBi", "BQT-VTU-2", "BQT-2B", "BBLV", "YCNK", "BBNTHT-CN", "PL BBNTHT", "BBBGCT", "BBBG", "Bia", "TH-TDQT", "TM TDQT", "TD-QT-TH", "BTL_HD")
For i = 0 To 14
Set sh = Nothing
On Error Resume Next
Set sh = wkbSource.Sheets(arrNames(i))
On Error GoTo 0
If Not sh Is Nothing Then
sh.Copy After:=wkbTarget.Worksheets(wkbTarget.Worksheets.count)
End If
Next
Else
arrNames = VBA.Array("DS_DoiTac", "Thongtin_CT", "TEMP", "Input_TBi", "BQT-VTU-2", "BQT-2B", "BBLV", "YCNK", "BBNTHT-CN", "PL BBNTHT", "BBBGCT", "BBBG", "Bia", "TH-TDQT", "TM TDQT", "TD-QT-TH", "BTL_HD")
For i = 0 To 16
Set sh = Nothing
On Error Resume Next
Set sh = wkbSource.Sheets(arrNames(i))
On Error GoTo 0
If Not sh Is Nothing Then
sh.Copy After:=wkbTarget.Worksheets(wkbTarget.Worksheets.count)
End If
Next
End If
wkbSource.Close False
MsgboxUni UNC("TuyÖt vêi!" & vbNewLine & _
"Ch¬ng tr×nh ®· chÌn c¸c Sheet cÇn thiÕt theo yªu cÇu!!!"), 64, UNC("Thong Bao")
Set wkbSource = Nothing
Set wkbTarget = Nothing
Call TangTocCode(False)
End If
End If
Exit Sub
QuitOpen:
MsgboxUni UNC("Kh«ng cã File nµo ®îc më!!!!."), 64, UNC("Thong Bao")
End Sub
Sub Run_ReaplaceLinks()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com
'LINK: https://www.thespreadsheetguru.com/the-code-vault/2014/4/14/find-and-replace-all
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim ReplaceCount As Long
fnd = "E:\DL QUYENPV\THIET KE 2021\0. Mau Phap Ly 2021\[1. Mau Ho so lam thau.xlsb]"
rplc = ""
For Each sht In ActiveWorkbook.Worksheets
ReplaceCount = ReplaceCount + Application.WorksheetFunction.CountIf(sht.Cells, "*" & fnd & "*")
sht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
' MsgBox "I have completed my search and made replacements in " & ReplaceCount & " cell(s)."
End Sub
Sub Insert_MakeRange()
'Tao Name cho BM4A
ActiveWorkbook.Names.Add Name:="DATA", RefersTo:="=OFFSET(TEMP!$B$4,,,COUNTA(TEMP!$B$4:$B$1048576),9)"
ActiveWorkbook.Names.Add Name:="LOC", RefersTo:="=IF(OFFSET(DATA,,,,1)=Input_TBi!$C1,ROW(INDIRECT(""1:"" & ROWS(DATA))),"""")"
'Tao Name DS Doi tac
ActiveWorkbook.Names.Add Name:="DS_DoiTac", RefersTo:="=OFFSET(DS_DoiTac!$P$4,,,COUNTIF(DS_DoiTac!$P$4:$P$101,""><""""""))"
End Sub
