Hàm cắt dấu trong Excel ~ sửa chữa máy tính hà nội giá rẻ

Home »

Hàm cắt dấu trong Excel

Thứ Sáu, 14 tháng 2, 2014
Hiện nay việc in ấn văn bằng, chứng chỉ bằng 2 thứ tiếng (song ngữ Anh-Việt) đã trở nên phổ biến vì vậy để in bằng một nửa bên trái là tiếng Việt, còn nửa bên phải là tiếng Anh làm đau đầu các nhà quản lý nếu không muốn bỏ tiền ra mua phần mềm. Tôi xin đưa ra 1 giải pháp rất đơn giản kết hợp giữa Word và Excel để in phôi bằng song ngữ, cách làm như sau: 
Bước 1: Tạo mẫu bằng trong Word và danh sách học sinh trong Excel 
+Tạo một mẫu bằng trong Word, mẫu này các vị trí như họ tên, ngày sinh v.v… phải khớp với bằng thật, lưu và đặt tên File này là Mau bang.doc 
+Tạo một danh sách trong Excel gồm họ tên, ngày sinh v.v….bên cạnh cột họ tên hoặc những cột cần chuyển sang tiếng Anh ta để một cột để chứa các từ cần chuyển thí dụ: Vĩnh Phúc sẽ chuyển thành Vinh Phuc chẳng hạn. Lưu và đặt tên File này là Danh sach.xls để cùng thư mục chứa Mau bang.doc 
Bước 2: Thiết lập hàm cắt dấu trong Excel. 
 
+Mở tập tin Danh sach.xls nháy vào Tools \ Macro \ Visual Basic Editor. 
+Nháy vào Insert chọn Module và chép đoạn mã dưới đây vào: 
Option Explicit 
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Dim Mang(13, 17) As String 
Sub NapBoDau() 
Dim i As Byte, j As Byte, n As Byte 
Dim Chuoi As String 
Dim Thga As String, Thge As String, Thgo As String, Thgu As String, Thgi As String, Thgd As String, Thgy As String 
Dim HoaA As String, HoaE As String, HoaO As String, HoaU As String, HoaI As String, HoaD As String, HoaY As String 
Chuoi = "aAeEoOuUiIdDyY" 
Thga = UnicodeChar(";E1;E0;1EA1;1EA3;E3;E2;1EA5;1EA7;1EAD;1EA9;1EAB;103;1EAF;1EB1;1EB7;1EB3;1EB5") 
HoaA = UnicodeChar(";C1;C0;1EA0;1EA2;C3;C2;1EA4;1EA6;1EAC;1EA8;1EAA;102;1EAE;1EB0;1EB6;1EB2;1EB4") 
Thge = UnicodeChar(";E9;E8;1EB9;1EBB;1EBD;EA;1EBF;1EC1;1EC7;1EC3;1EC5;65;65;65;65;65;65") 
HoaE = UnicodeChar(";C9;C8;1EB8;1EBA;1EBC;CA;1EBE;1EC0;1EC6;1EC2;1EC4;45;45;45;45;45;45") 
Thgo = UnicodeChar(";F3;F2;1ECD;1ECF;F5;F4;1ED1;1ED3;1ED9;1ED5;1ED7;1A1;1EDB;1EDD;1EE3;1EDF;1EE1") 
HoaO = UnicodeChar(";D3;D2;1ECC;1ECE;D5;D4;1ED0;1ED2;1ED8;1ED4;1ED6;1A0;1EDA;1EDC;1EE2;1EDE;1EE0") 
Thgu = UnicodeChar(";FA;F9;1EE5;1EE7;169;1B0;1EE9;1EEB;1EF1;1EED;1EEF;75;75;75;75;75;75") 
HoaU = UnicodeChar(";DA;D9;1EE4;1EE6;168;1AF;1EE8;1EEA;1EF0;1EEC;1EEE;55;55;55;55;55;55") 
Thgi = UnicodeChar(";ED;EC;1ECB;1EC9;129;69;69;69;69;69;69;69;69;69;69;69;69") 
HoaI = UnicodeChar(";CD;CC;1ECA;1EC8;128;49;49;49;49;49;49;49;49;49;49;49;49") 
Thgd = UnicodeChar(";111;64;64;64;64;64;64;64;64;64;64;64;64;64;64;64;64") 
HoaD = UnicodeChar(";110;44;44;44;44;44;44;44;44;44;44;44;44;44;44;44;44") 
Thgy = UnicodeChar(";FD;1EF3;1EF5;1EF7;1EF9;79;79;79;79;79;79;79;79;79;79;79;79") 
HoaY = UnicodeChar(";DD;1EF2;1EF4;1EF6;1EF8;59;59;59;59;59;59;59;59;59;59;59;59") 
For i = 0 To 13 
Mang(i, 0) = Mid(Chuoi, i + 1, 1) 
Next 
For j = 1 To 17 
For i = 1 To 17 
Mang(0, i) = Mid(Thga, i, 1) 
Mang(1, i) = Mid(HoaA, i, 1) 
Mang(2, i) = Mid(Thge, i, 1) 
Mang(3, i) = Mid(HoaE, i, 1) 
Mang(4, i) = Mid(Thgo, i, 1) 
Mang(5, i) = Mid(HoaO, i, 1) 
Mang(6, i) = Mid(Thgu, i, 1) 
Mang(7, i) = Mid(HoaU, i, 1) 
Mang(8, i) = Mid(Thgi, i, 1) 
Mang(9, i) = Mid(HoaI, i, 1) 
Mang(10, i) = Mid(Thgd, i, 1) 
Mang(11, i) = Mid(HoaD, i, 1) 
Mang(12, i) = Mid(Thgy, i, 1) 
Mang(13, i) = Mid(HoaY, i, 1) 
Next 
Next 
End Sub 
Function UnicodeChar(UniCharCode As String) As String 
On Error GoTo er 
Dim str 
Dim desStr As String 
Dim i 
If Mid(UniCharCode, 1, 1) = ";" Then 
UniCharCode = Mid(UniCharCode, 2) 
End If 
If Right(UniCharCode, 1) = ";" Then 
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1) 
End If 
str = UniCharCode 
str = Split(str, ";") 
For i = LBound(str) To UBound(str) 
desStr = desStr & ChrW$("&H" & str(i)) 
Next 
UnicodeChar = desStr 
er: 
If Len(Error) > 0 Then 
MsgBox Error 
End If 
End Function 
Function BoDau(MyText As String) As String 
Dim Tam1 As String, Tam2 As String 
Dim i As Byte, j As Byte, n As Byte 
NapBoDau 
Tam1 = MyText 
For j = 0 To 13 
For i = 1 To 17 
Tam2 = Replace(Tam1, Mang(j, i), Mang(j, 0), 1, -1, vbBinaryCompare) 
Tam1 = Tam2 
Next 
Next 
BoDau = Tam1 
End Function 
+Nháy vào File \ Save để ghi lại. 
+Đặt con trỏ vào ô định cắt dấu họ và tên thí dụ ô C3, gõ công thức =bodau(B3) sau đó ấn Enter, sao chép công thức ô C3 xuống các ô khác trong cột. 
+Các cột khác như nơi sinh bạn làm tương tự. 
 
Bước 3: Tiến hành trộn thư giữa Word và Excel. 
Để tạo bằng song ngữ bạn tiến hành trộn thư giữa Word và Excel để có kết quả, phần này tôi coi như bạn đã biết. 
Tags:

Comments[ 0 ]


Đăng nhận xét