Đây là video hướng dẫn cách tạo DLL trên Delphi nhưng sử dụng trong VBA, Excel. Đây là phương pháp lập trình chuyên nghiệp nhưng không phải là khó. Giúp bạn bảo mật code của phần mềm tốt hơn.
Declare Function CopyDataRange Lib "VBLibrary.dll" _
(ByVal ExcelPath As Variant, _
ByVal sSQL As Variant, _
ByVal Target As Variant) As Long
Rem ==========
Sub MainCopyDataRange()
Dim FilePath As Variant, DataRange As Variant
DataRange = "Data_Nhap" ''Ten SheetName (ko Phai SheetCodeName)
Cells.ClearContents
FilePath = ThisWorkbook.Path & "\Data.xlsb"
Call CopyDataRange(FilePath, DataRange, Range("A2"))
End Sub
Cái này thấy có 3 người coi bộ cũng vui, còn mấy bửa nay cái vụ VSTO của tôi mày mò có một mình cũng buồn, nhưng càng mày mò thì cách thấy nó cũng hay hay. Nhưng sao mò một mình lâu quá, có khi một vấn đề mà mất mấy hôm luôn.
Cái này thấy có 3 người coi bộ cũng vui, còn mấy bửa nay cái vụ VSTO của tôi mày mò có một mình cũng buồn, nhưng càng mày mò thì cách thấy nó cũng hay hay. Nhưng sao mò một mình lâu quá, có khi một vấn đề mà mất mấy hôm luôn.
qua đây đi cho xôm tụ vui vẻ .... Mạnh Học thấy ok đó ... Bước qua cái ngưỡng khai báo và cú pháp là Tạm ok
Còn thuật toán linh tinh trong đó viết nhiều kẹt tới đâu hỏi tới đó khắc tự nó khá lên à ??!!
Cái này thấy có 3 người coi bộ cũng vui, còn mấy bửa nay cái vụ VSTO của tôi mày mò có một mình cũng buồn, nhưng càng mày mò thì cách thấy nó cũng hay hay. Nhưng sao mò một mình lâu quá, có khi một vấn đề mà mất mấy hôm luôn.
Tặng cho bạn nào có ý đinh nhập Môn Delphi sử dụng ADO lấy dữ liệu vào Mảng 2dArray
1/ Mục đích mong muốn các bạn tiếp cận Delphi gần gủi hơn với VBA ...
2/ Có Nhiều Bạn tham gia học .... sẻ có nhiều câu hỏi phát sinh hay ==> sẻ có nhiều cái hay mà học tương tác qua lại lẫn nhau ??!!!!
3/ Nếu 2 mục trên phát triển tốt thì từng bước Mạnh sẻ học Delphi tốt hơn rất nhiều
4/ Vì mấy mục trên Nên Mạnh viết được code nào Úp cho các bạn tham khảo và điều chỉnh bổ sung thêm cho hoàn thiện
....
5/ Phải nói thật là 2 thầy chỉ 1 trò học nhanh thật ... Xin cảm ơn
Hàm trong File *.dll Delphi
Mã:
Function GetDataRangeArray(ExcelPath, sSQL: OleVariant): OleVariant; stdcall;
var
cnn,Rst : OleVariant;
SQL,Strcon : string;
x : OleVariant;
begin
cnn := CreateOleObject('ADODB.Connection') ;
Rst := CreateOleObject('ADODB.Recordset');
Strcon := 'Provider=Microsoft.ACE.OLEDB.12.0;Data Source=' + ExcelPath +
';Extended Properties="Excel 12.0 Xml;HDR=YES";';
cnn.open(Strcon);
SQL := 'select * from ['+ sSQL + '$]' ;
Rst.Open(SQL, cnn, 3, 1) ;
x := rst.RecordCount;
If Not Rst.EOF Then begin
ShowMessage(x);
Result := rst.GetRows();
end;
end;
Khai báo sử dụng trên VBA
Mã:
Declare Function GetDataRangeArray Lib "VBLibrary.dll" _
(ByVal ExcelPath As Variant, _
ByVal sSQL As Variant) As Variant
Sub Main_GetDataRangeArray()
Dim FilePath As Variant, DataRange As Variant
Dim Arr As Variant, dArr(), i As Long, j As Long
DataRange = "Data_Nhap" ''Ten SheetName
FilePath = ThisWorkbook.Path & "\Data.xlsb"
Arr = GetDataRangeArray(FilePath, DataRange)
ReDim dArr(1 To UBound(Arr, 2) + 1, 1 To UBound(Arr, 1) + 1) ''Chuyen mang
For i = 0 To UBound(Arr, 2) ''Mang ADO lay len Bat dau tu o
For j = 0 To UBound(Arr, 1)
dArr(i + 1, j + 1) = Arr(j, i) ''Mang ADO lay len Bat dau tu o nen Phai + them 1
Next
Next
Cells.ClearContents
Range("A4").Resize(UBound(dArr, 1), UBound(dArr, 2)) = dArr
End Sub
Tặng cho bạn nào có ý đinh nhập Môn Delphi sử dụng ADO lấy dữ liệu vào Mảng 2dArray
1/ Mục đích mong muốn các bạn tiếp cận Delphi gần gủi hơn với VBA ...
2/ Có Nhiều Bạn tham gia học .... sẻ có nhiều câu hỏi phát sinh hay ==> sẻ có nhiều cái hay mà học tương tác qua lại lẫn nhau ??!!!!
3/ Nếu 2 mục trên phát triển tốt thì từng bước Mạnh sẻ học Delphi tốt hơn rất nhiều
4/ Vì mấy mục trên Nên Mạnh viết được code nào Úp cho các bạn tham khảo và điều chỉnh bổ sung thêm cho hoàn thiện
....
5/ Phải nói thật là 2 thầy chỉ 1 trò học nhanh thật ... Xin cảm ơn
Hàm trong File *.dll Delphi
Mã:
Function GetDataRangeArray(ExcelPath, sSQL: OleVariant): OleVariant; stdcall;
var
cnn,Rst : OleVariant;
SQL,Strcon : string;
[CODE]try
finally
end;
try
except
end;
x : OleVariant;
begin
cnn := CreateOleObject('ADODB.Connection') ;
Rst := CreateOleObject('ADODB.Recordset');
Strcon := 'Provider=Microsoft.ACE.OLEDB.12.0;Data Source=' + ExcelPath +
';Extended Properties="Excel 12.0 Xml;HDR=YES";';
cnn.open(Strcon);
SQL := 'select * from ['+ sSQL + '$]' ;
Rst.Open(SQL, cnn, 3, 1) ;
x := rst.RecordCount;
If Not Rst.EOF Then begin
ShowMessage(x);
Result := rst.GetRows();
end;
end;[/CODE]
Khai báo sử dụng trên VBA
Mã:
Declare Function GetDataRangeArray Lib "VBLibrary.dll" _
(ByVal ExcelPath As Variant, _
ByVal sSQL As Variant) As Variant
Sub Main_GetDataRangeArray()
Dim FilePath As Variant, DataRange As Variant
Dim Arr As Variant, dArr(), i As Long, j As Long
DataRange = "Data_Nhap" ''Ten SheetName
FilePath = ThisWorkbook.Path & "\Data.xlsb"
Arr = GetDataRangeArray(FilePath, DataRange)
ReDim dArr(1 To UBound(Arr, 2) + 1, 1 To UBound(Arr, 1) + 1) ''Chuyen mang
For i = 0 To UBound(Arr, 2) ''Mang ADO lay len Bat dau tu o
For j = 0 To UBound(Arr, 1)
dArr(i + 1, j + 1) = Arr(j, i) ''Mang ADO lay len Bat dau tu o nen Phai + them 1
Next
Next
Cells.ClearContents
Range("A4").Resize(UBound(dArr, 1), UBound(dArr, 2)) = dArr
End Sub
Các Bạn cho Mình hỏi chút
Trên VBA mình viết Hàm có Tùy chọn : Optional Vậy trên Delphi viết Hàm xài Tùy chon Optional như thế nào .... Mong chỉ dẫn
VD: trên VBA mình Viết Hàm sau: Vậy Trong Delphi Viết Sao
Mã:
Public Function UniMsgbox(Optional Message$, Optional TimeOut = "", Optional Format = "", Optional Msg)
Rem Cu Phap object.Popup (Message [, TimeOut][, Title] [, Format])
Dim Title As String
If Format = "" Then Format = 64 '' Icon Mac dinh la 64 ...Tuy Chon Tham So 1,2,3,4,5,48,64,65,67,68...
If TimeOut = "" Then TimeOut = 3 '' Thoi gian Thoat Mac dinh la 3 Giay
Title = "Ph" & ChrW(432) & ChrW(417) & "ng" & " Nam" & " Telecom" & ChrW(174)
Msg = CreateObject("Wscript.shell").PopUp(Message, TimeOut, Title, Format)
End Function
Cách khai báo tham số ngầm định trong hàm haowcj thủ tục:
+ Trong VBA: Optional Byval Bien As Boolean = True
+ Trong Delphi: const Bien: Boolean = True
Khi khai báo hàm API trong VBA thì khai báo Optional nếu bạn cần, dù trong hàm Delphi không khai báo tùy chọn.
Mạnh viết 1 Sub mảng lọc ngày/thang/nam To ngay/thang/nam ... Lọc mảng 1dArray
1/ Code viết chạy tốt ... tốc độ rất nhanh
2/ Úp bài nhờ các Bạn coi dùm cách khai báo và truyền 1 tham số Date trong Delphi như vậy là đúng chưa ?! ...
cấu trúc viết 1 Sub truyền tham số như vậy là ok chưa vv...
3/ Code trong Delpohi *.dll
Mã:
procedure FilterDate1dArray(sArr: OleVariant; Fdate, Edate: TDateTime;
ColDate: Longint; Range: OleVariant); stdcall;
var
Arr : OleVariant;
i,j,k : longint;
lcols,lRows : longint;
begin
k := 0;
lRows := VarArrayHighBound(sArr, 1); //So dong ko xac dinh
lCols := VarArrayHighBound(sArr, 2); //So Cot ko Xac dinh
Arr := VarArrayCreate([1, lRows , 1, lcols],varVariant);
for i := 1 to lRows do begin
If sArr[i, ColDate] >= Fdate Then begin
If sArr[i, ColDate] <= Edate Then begin
k := k + 1;
For j := 1 To lcols do begin
Arr[k, j] := sArr[i, j];
End;
End;
End;
End;
if k <> 0 then begin
Range.Resize[k, lcols]:=Arr; //gan ket Qua Len Range Theo Mang Arr
end;
End;
4/ Khai báo sử dụng Hàm trên VBA
Mã:
Declare Sub FilterDate1dArray Lib "VBLibrary.dll" (ByVal sArr As Variant, _
ByVal Fdate As Date, ByVal Edate As Date, _
ByVal ColDate As Long, ByVal Target As Variant)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr As Variant
Dim Fdate As Date, Edate As Date
Fdate = [I1].Value ''Ngay bat dau
Edate = [I2].Value ''ngay ket thuc
Arr = Sheet1.Range("A2:I65536").Value
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, [I1:I2]) Is Nothing Then
If Not IsNumeric(Target) And Not IsDate(Target) Then
Target = ""
Target.Select
Else
Range("A3:I1000").ClearContents
Call FilterDate1dArray(Arr, Fdate, Edate, 9, [A3]) ''Tham số 9 là cột ngay/thang/nam
Target.Select
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Theo mình nghĩ bạn nên tải Delphi7 vì bản này rất nhẹ có trên 200M sau khi cài đặt ( có điều bản này ko hổ trợ Unicode và Build đa nền tảng ...)
Còn Delphi thì rất nhiều bản hiện mình đang xài Delphi XE6
sau này rành rồi thì cả xài bản mới nhất he
Tìm với Google nhé https://www.google.com.vn/search?q=...69i57j69i65.3010j0j7&sourceid=chrome&ie=UTF-8
Cái này thấy có 3 người coi bộ cũng vui, còn mấy bửa nay cái vụ VSTO của tôi mày mò có một mình cũng buồn, nhưng càng mày mò thì cách thấy nó cũng hay hay. Nhưng sao mò một mình lâu quá, có khi một vấn đề mà mất mấy hôm luôn.
Mình đang nghiên cứu VSTO thấy cũng hay và đang tiến bộ về nó, nhưng do không có nhiều thời gian nên vẫn đang bò từ từ. Mà bạn đã từng dùng VSTO sẳn cho hỏi luôn (đừng cho là lạc chủ đề nhé) sao mình thao tác thay đổi giá trị trong ô của Excel nó hơi chậm hơn so với dùng code VBA, mặc dù giải thuật như nhau. Ví dụ mình muốn thay đổi Font chữ trong vùng đang chọn (Khoảng 1000 dòng, 20 cột), thì dùng code VBA sẽ nhanh hơn khoảng 1 giây so với code VSTO. Còn nếu dùng mảng lưu giá trị và gán ngược vào ô trong Excel thì như nhau (Nhưng cách này lại không phù hợp vì vùng chọn có thể các ô không liên tục). Bạn từng dùng và có kinh nghiệm chia sẻ cho mình với (Có thể chỉ hướng không cần code mẫu cũng được).
Mình đang nghiên cứu VSTO thấy cũng hay và đang tiến bộ về nó, nhưng do không có nhiều thời gian nên vẫn đang bò từ từ. Mà bạn đã từng dùng VSTO sẳn cho hỏi luôn (đừng cho là lạc chủ đề nhé) sao mình thao tác thay đổi giá trị trong ô của Excel nó hơi chậm hơn so với dùng code VBA, mặc dù giải thuật như nhau. Ví dụ mình muốn thay đổi Font chữ trong vùng đang chọn (Khoảng 1000 dòng, 20 cột), thì dùng code VBA sẽ nhanh hơn khoảng 1 giây so với code VSTO. Còn nếu dùng mảng lưu giá trị và gán ngược vào ô trong Excel thì như nhau (Nhưng cách này lại không phù hợp vì vùng chọn có thể các ô không liên tục). Bạn từng dùng và có kinh nghiệm chia sẻ cho mình với (Có thể chỉ hướng không cần code mẫu cũng được).
Mạnh bỏ 2 năm nay rồi ko cài nên ko thử lại nên ko biết
Chỉ biết là hồi đó viết cái Add-ins *.xll thấy chạy tốt tuy nhiên viết nhiều code vô đó khi nó load chậm quá và xài lại các hàm trong đó rất bất tiện
nếu ai đó xài bản thân file của người ta đầy hàm linh tinh mở lên đã chậm ròi lại cỏng thêm cái add-ins kia nữa mới thấy cảnh bực bội .... vì vậy mạnh bỏ lâu rồi ...
Có lẻ 1 mình 1 ngựa và 1 con đường chạy đi he
Mạnh nói nhỏ thui he hỏi HLMT ý .... hay món đó lắm he ... hôm rồi thấy úp lên Facebook thử nghiệm hay lắm he
Mạnh viết 1 Sub mảng lọc ngày/thang/nam To ngay/thang/nam ... Lọc mảng 1dArray
1/ Code viết chạy tốt ... tốc độ rất nhanh
2/ Úp bài nhờ các Bạn coi dùm cách khai báo và truyền 1 tham số Date trong Delphi như vậy là đúng chưa ?! ...
cấu trúc viết 1 Sub truyền tham số như vậy là ok chưa vv...
3/ Code trong Delpohi *.dll
Mã:
procedure FilterDate1dArray(sArr: OleVariant; Fdate, Edate: TDateTime;
ColDate: Longint; Range: OleVariant); stdcall;
var
Arr : OleVariant;
i,j,k : longint;
lcols,lRows : longint;
begin
k := 0;
lRows := VarArrayHighBound(sArr, 1); //So dong ko xac dinh
lCols := VarArrayHighBound(sArr, 2); //So Cot ko Xac dinh
Arr := VarArrayCreate([1, lRows , 1, lcols],varVariant);
for i := 1 to lRows do begin
If sArr[i, ColDate] >= Fdate Then begin
If sArr[i, ColDate] <= Edate Then begin
k := k + 1;
For j := 1 To lcols do begin
Arr[k, j] := sArr[i, j];
End;
End;
End;
End;
if k <> 0 then begin
Range.Resize[k, lcols]:=Arr; //gan ket Qua Len Range Theo Mang Arr
end;
End;
4/ Khai báo sử dụng Hàm trên VBA
Mã:
Declare Sub FilterDate1dArray Lib "VBLibrary.dll" (ByVal sArr As Variant, _
ByVal Fdate As Date, ByVal Edate As Date, _
ByVal ColDate As Long, ByVal Target As Variant)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr As Variant
Dim Fdate As Date, Edate As Date
Fdate = [I1].Value ''Ngay bat dau
Edate = [I2].Value ''ngay ket thuc
Arr = Sheet1.Range("A2:I65536").Value
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, [I1:I2]) Is Nothing Then
If Not IsNumeric(Target) And Not IsDate(Target) Then
Target = ""
Target.Select
Else
Range("A3:I1000").ClearContents
Call FilterDate1dArray(Arr, Fdate, Edate, 9, [A3]) ''Tham số 9 là cột ngay/thang/nam
Target.Select
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
qua đây đi cho xôm tụ vui vẻ .... Mạnh Học thấy ok đó ... Bước qua cái ngưỡng khai báo và cú pháp là Tạm ok
