Mã nguồn Add-Ins *.xll trên Delphi cho Excel

Liên hệ QC
xlcall.h có nhiều lệnh nhưng không biết sử dụng trong Excel4V như xlcPageSetup, xlcNewWindow .....................
 
không đi đâu về đâu cả ... cuốn theo chiều gió thôi --=0--=0--=0

Rảnh tôi đang nghiên cứu cái DataSnap chạy đa tầng, đa dịch vụ trên Web Server xong thì nó xử lý mọi thứ. nếu thích xuất hàm qua Excel khai báo một

hàm trung gian xong chỉ call nó chạy vèo vèo ... thay vì cố với cái xll làm chi cho nhọc xác ra _+)(9
 
  • Thích
Reactions: A-T
File dXLCall.pas tác giả port có lỗi, build trên 64bit té hổng cẳng đó. Tìm khùng luôn.
 
Port từ 2012, chưa có Delphi x64

1697518975118.png
 
chính xác là vậy ..

Khó nhất là dựa vào đó viết 1 class tùy chỉnh liên kết sử dụng cho hàm với nhiều tham số

còn khai báo thủ công theo chỉ dẫn của Ms sẻ rất khó cho ai đó mới tập tành sử dụng nó

nếu ai đó thích hay có nhu cầu tôi sẻ úp tiếp file tạo Menu Ribbon cho Delphi lên cho tham khảo thêm như mô tả bài số 14

File đo tân thành viên GPE viết còn phần XML cho Delphi + VB6 do Tôi kết hợp với Tân Viết sẻ hổ trợ tạo menu Ribbon trên VBA + VB6 + Delphi = 3 trong 1
 
  • Thích
Reactions: A-T
Kiều Mạnh đã viết:
chính xác là vậy ..

Khó nhất là dựa vào đó viết 1 class tùy chỉnh liên kết sử dụng cho hàm với nhiều tham số

còn khai báo thủ công theo chỉ dẫn của Ms sẻ rất khó cho ai đó mới tập tành sử dụng nó

nếu ai đó thích hay có nhu cầu tôi sẻ úp tiếp file tạo Menu Ribbon cho Delphi lên cho tham khảo thêm như mô tả bài số 14

File đo tân thành viên GPE viết còn phần XML cho Delphi + VB6 do Tôi kết hợp với Tân Viết sẻ hổ trợ tạo menu Ribbon trên VBA + VB6 + Delphi = 3 trong 1
Nhấp chuột vào đây để mở rộng...
Cứ upload lên ai cần thì họ dùng, họ cảm ơn. Còn đây thì chỉ thấy Úp - Mở thôi.
Trong ngôn ngữ lập trình Pascal thì phải, thấy họ viết như thế lày:

unit ExcelApp.MenuButton.pas;

interface

uses Office2000_TLB, ExcelApp.EventSink;

type
TMenuButton = class(TObject)
private
FID: string;
FButton: _CommandBarButton;
FSink: TEventSink;
FCookie: Integer;
FClickProc: TClickProc;
public
constructor Create(const Parent: CommandBarPopup; const strID: string; const strCaption:
string; const EventHandler: TClickProc; const MenuOptions: TMenuOptions); overload;

constructor Create(const Parent: CommandBar; const strCaption: string; const EventHandler:
TClickProc; const MenuOptions: TMenuOptions); overload;
destructor Destroy; override;
property Button: _CommandBarButton read FButton;
property ID: string read FID default 0;
property ClickProc: TClickProc read FClickProc;
end;

implementation

{ TMenuButton }

constructor TMenuButton.Create(const Parent: CommandBarPopup; const strID: string; const
strCaption: string; const EventHandler: TClickProc; const MenuOptions: TMenuOptions);
begin

end;

constructor TMenuButton.Create(const Parent: CommandBar; const strCaption: string; const
EventHandler: TClickProc; const MenuOptions: TMenuOptions);
begin

end;

destructor TMenuButton.Destroy;
begin

end;

end.
------------------------------------------------------------
1697524356361.png

unit Unit2;

interface

uses
Windows, ActiveX, ComObj, Variants;

const
CLASS_DTExtensibility2: TGUID = '{AD1C5BA3-0140-4E45-8C92-2550B1271BC0}';

type
IDTExtensibility2 = interface(IDispatch)
['{B65AD801-ABAF-11D0-BB8B-00A0C90F2744}']
procedure OnConnection(const HostApp: IDispatch; ext_ConnectMode: Integer;
const AddInInst: IDispatch; var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer; var custom: PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
procedure BeginShutdown(var custom: PSafeArray); safecall;
procedure DoAction(const Control: IUnknown); safecall;

function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
end;

IRibbonExtensibility = interface(IDispatch)
['{000C0396-0000-0000-C000-000000000046}']
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
end;

TOfficeAddInsTest = class(TAutoObject, IDTExtensibility2, IRibbonExtensibility)
private

protected
procedure BeginShutdown(var custom: PSafeArray); safecall;
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;

procedure DoAction(const Button: IUnknown); safecall;
function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
end;

implementation

uses
AxCtrls, Graphics, ComServ;

procedure TOfficeAddInsTest.OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.BeginShutdown(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnAddInsUpdate(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnStartupComplete(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.DoAction(const Button: IUnknown);
begin
MessageBox(0, 'Hello, World', 'Information', MB_ICONINFORMATION)
end;

function TOfficeAddInsTest.DoLoadImage(const aImageName: WideString): IPictureDisp;
var
PictureDesc: TPictDesc;
begin
if aImageName = 'mainicon.ico' then begin
with PictureDesc do begin
cbSizeOfStruct := SizeOf(PictureDesc);
picType := PICTYPE_ICON;
hIcon := LoadIcon(HInstance, 'MAINICON')
end;
OleCheck(OleCreatePictureIndirect(PictureDesc, IPicture, True, Result))
end else
Result := nil
end;

function TOfficeAddInsTest.GetCustomUI(const RibbonID: WideString): WideString; safecall;
begin
Result :=
'<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" loadImage="DoLoadImage">'#13#10+
' <ribbon>'#13#10+
' <officeMenu>'#13#10+
' <menu idMso="FileSendMenu">'#13#10+
// ' <button id="TestButtonID" insertAfterMso="FileSendAsAttachment" label="Hello, World!" imageMso ="HappyFace" onAction="DoAction"/>'#13#10+
' <button id="TestButtonID" insertAfterMso="FileSendAsAttachment" label="Hello, World!" image="mainicon.ico" onAction="DoAction"/>'#13#10+
' </menu>'#13#10+
' </officeMenu>'#13#10+
' </ribbon>'#13#10+
'</customUI>'
end;

initialization
TAutoObjectFactory.Create(ComServer, TOfficeAddInsTest, CLASS_DTExtensibility2, ciSingleInstance);
end.
 
Lần chỉnh sửa cuối:
A-T đã viết:
Cứ upload lên ai cần thì họ dùng, họ cảm ơn. Còn đây thì chỉ thấy Úp - Mở thôi.
Vào trang http://techvanguards.com/ của Bác BinhLy
https://github.com/jhc-systems/DelphiUIAutomation
https://www.davidghoyle.co.uk/WordPress/?p=311
Hình như bằng ngôn ngữ lập trình Pascal thì phải, thấy họ viết như thế lày:

unit ExcelApp.MenuButton.pas;

interface

uses Office2000_TLB, ExcelApp.EventSink;

type
TMenuButton = class(TObject)
private
FID: string;
FButton: _CommandBarButton;
FSink: TEventSink;
FCookie: Integer;
FClickProc: TClickProc;
public
constructor Create(const Parent: CommandBarPopup; const strID: string; const strCaption:
string; const EventHandler: TClickProc; const MenuOptions: TMenuOptions); overload;

constructor Create(const Parent: CommandBar; const strCaption: string; const EventHandler:
TClickProc; const MenuOptions: TMenuOptions); overload;
destructor Destroy; override;
property Button: _CommandBarButton read FButton;
property ID: string read FID default 0;
property ClickProc: TClickProc read FClickProc;
end;

implementation

{ TMenuButton }

constructor TMenuButton.Create(const Parent: CommandBarPopup; const strID: string; const
strCaption: string; const EventHandler: TClickProc; const MenuOptions: TMenuOptions);
begin

end;

constructor TMenuButton.Create(const Parent: CommandBar; const strCaption: string; const
EventHandler: TClickProc; const MenuOptions: TMenuOptions);
begin

end;

destructor TMenuButton.Destroy;
begin

end;

end.
------------------------------------------------------------
View attachment 295814

unit Unit2;

interface

uses
Windows, ActiveX, ComObj, Variants;

const
CLASS_DTExtensibility2: TGUID = '{AD1C5BA3-0140-4E45-8C92-2550B1271BC0}';

type
IDTExtensibility2 = interface(IDispatch)
['{B65AD801-ABAF-11D0-BB8B-00A0C90F2744}']
procedure OnConnection(const HostApp: IDispatch; ext_ConnectMode: Integer;
const AddInInst: IDispatch; var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer; var custom: PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
procedure BeginShutdown(var custom: PSafeArray); safecall;
procedure DoAction(const Control: IUnknown); safecall;

function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
end;

IRibbonExtensibility = interface(IDispatch)
['{000C0396-0000-0000-C000-000000000046}']
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
end;

TOfficeAddInsTest = class(TAutoObject, IDTExtensibility2, IRibbonExtensibility)
private

protected
procedure BeginShutdown(var custom: PSafeArray); safecall;
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;

procedure DoAction(const Button: IUnknown); safecall;
function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
end;

implementation

uses
AxCtrls, Graphics, ComServ;

procedure TOfficeAddInsTest.OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.BeginShutdown(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnAddInsUpdate(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnStartupComplete(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.DoAction(const Button: IUnknown);
begin
MessageBox(0, 'Hello, World', 'Information', MB_ICONINFORMATION)
end;

function TOfficeAddInsTest.DoLoadImage(const aImageName: WideString): IPictureDisp;
var
PictureDesc: TPictDesc;
begin
if aImageName = 'mainicon.ico' then begin
with PictureDesc do begin
cbSizeOfStruct := SizeOf(PictureDesc);
picType := PICTYPE_ICON;
hIcon := LoadIcon(HInstance, 'MAINICON')
end;
OleCheck(OleCreatePictureIndirect(PictureDesc, IPicture, True, Result))
end else
Result := nil
end;

function TOfficeAddInsTest.GetCustomUI(const RibbonID: WideString): WideString; safecall;
begin
Result :=
'<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" loadImage="DoLoadImage">'#13#10+
' <ribbon>'#13#10+
' <officeMenu>'#13#10+
' <menu idMso="FileSendMenu">'#13#10+
// ' <button id="TestButtonID" insertAfterMso="FileSendAsAttachment" label="Hello, World!" imageMso ="HappyFace" onAction="DoAction"/>'#13#10+
' <button id="TestButtonID" insertAfterMso="FileSendAsAttachment" label="Hello, World!" image="mainicon.ico" onAction="DoAction"/>'#13#10+
' </menu>'#13#10+
' </officeMenu>'#13#10+
' </ribbon>'#13#10+
'</customUI>'
end;

initialization
TAutoObjectFactory.Create(ComServer, TOfficeAddInsTest, CLASS_DTExtensibility2, ciSingleInstance);
end.
Nhấp chuột vào đây để mở rộng...
Mới tải về xem thấy như sau + 2 link khác ngó qua thì làm biếng xem tiếp

Lưu lại đó thong thả ngó lại

1697528984373.png

File Tạo Menu Ribbon cho VBA + VB6 + Delphi Tôi úp lên đây ai cần thì tham khảo sử dụng ( Như mô tả bài số 26 )

nếu ai đó có khả năng khá hơn thì kế thừa mà viết tốt hơn xong úp lại cho ai đó cần lại kế thừa của kế thừa tiếp

Nếu chưa biết sử dụng thì cứ nói Tôi sẻ chỉ dẫn ... trước khi hỏi hãy dò làm trước xem sao rồi hãy hỏi !?

1697529852860.png

Cái này có vẻ tốt không lỗi khi builder nó ... thong thả dò mới ngộ ra được

Hàm sau thiết kế sử dụng cho Delphi 7 trở lên vì Delphi 7 không hổ trợ Unicode nên tôi với Tân cố tình viết vậy và dùng cho VB6 nữa

Mã: 
Rem =========== Ap dung cho Delphi
Public Function GetXML_Delphi(ByRef GTri As Boolean, ByVal mTHop As Byte) As String
    Rem Luu trong Sub ExportXML Module Code_In_Ribbon_help Ap dung cho Xuat XML Cho Delphi
    Dim a As Long, b As Long, c As Long, s As String, Arrs, Arrd(1 To 10000)
    Arrs = mArr(1, mTHop) 'Sheet1.Range("A3:AZ" & Sheet1.Cells(&H100000, 1).End(xlUp).Row).Value
    a = 0
    a = a + 1: Arrd(a) = "<customUI xmlns=""http://schemas.microsoft.com/office/2006/01/customui""" & _
            IIf(mTHop > 1, " onLoad= ""onLoad""", "") & ">"
    a = a + 1: Arrd(a) = "<ribbon startFromScratch=""false"">"
    a = a + 1: Arrd(a) = "    <tabs>" & IIf((mTHop = 1 Or mTHop = 3), "", vbNewLine & _
            "      <!-- Doan nay dung de an Tab he thong-->" & vbNewLine & _
            "      <tab idMso=""TabHome"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabInsert"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabPageLayoutExcel"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabFormulas"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabData"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabReview"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabView"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabDeveloper"" getVisible=""getVisible""/>" & vbNewLine & _
            "      <tab idMso=""TabAddIns"" getVisible=""getVisible""/>") '' & vbNewLine
    For b = RwStar + 2 To UBound(Arrs, 1)
        If Len(LTrim(Arrs(b, 1))) > 0 Then
            s = Space(Get_Str(Arrs(b, 1)) + 6)
            If LTrim(Arrs(b, 1)) Like "End *" Then
                s = s & Replace(LTrim(Arrs(b, 1)), "End ", "</") & ">"
            Else
                s = s & "<" & LTrim(Arrs(b, 1))
                For c = 2 To UBound(Arrs, 2)
                    If Len(Arrs(b, c)) > 0 Then
                        s = s & get_XXX(Arrs, b, c, mTHop)
                    End If
                Next
                If " item " Like "* " & LTrim(Arrs(b, 1)) & " *" And (mTHop = 3 Or mTHop = 4) Then
                    If Not IsEmpty(Sheet1.Cells(b, xlabel)) Then s = s & " label=""" & Sheet1.Cells(b, xlabel) & """"
                    If Not IsEmpty(Sheet1.Cells(b, xscreentip)) Then s = s & " screentip=""" & Sheet1.Cells(b, xscreentip) & """"
                    If Not IsEmpty(Sheet1.Cells(b, xsupertip)) Then s = s & " supertip=""" & Sheet1.Cells(b, xsupertip) & """"
                End If
                s = s & IIf(" box buttonGroup comboBox dialogBoxLauncher dropDown group menu splitButton tab " Like "* " & LTrim(Arrs(b, 1)) & " *", ">", "/" & ">")
            End If
            If Len(Arrs(b, ximage)) > 0 Then s = s & "<!--" & Arrs(b, ximage) & "-->"
            a = a + 1: Arrd(a) = s
        End If
    Next
    a = a + 1: Arrd(a) = "    </tabs>"
    a = a + 1: Arrd(a) = "  </ribbon>"
    a = a + 1: Arrd(a) = "</customUI>"
   
    For b = 1 To a
        GetXML_Delphi = GetXML_Delphi & vbNewLine & "'" & Arrd(b)
    Next
    GetXML_Delphi = RibbonTV(Mid(GetXML_Delphi, 3))
    GetXML_Delphi = Replace(GetXML_Delphi, vbNewLine, "'#13#10 +" & vbNewLine)
    GetXML_Delphi = "result := " & GetXML_Delphi '17h32 them cai nay
    GetXML_Delphi = GetXML_Delphi & "';"
End Function

Mấu chốt ở hàm sau nếu ai đó sử dụng Delphi các bản sau này có hổ trợ Unicode thì loại bỏ nó ra

Mã: 
Rem =========== Chuyen doi tieng Viet co dau tren Ribbon
Private Function RibbonTV(ByVal myText As String) As String
    Dim i As Long, myWord As Long
    For i = 1 To Len(myText)
        myWord = AscW(Mid$(myText, i, 1))
        If myWord < &H80 Then
            RibbonTV = RibbonTV & Chr$(myWord)
        Else
            RibbonTV = RibbonTV & "&#" & myWord & ";"
        End If
    Next i
End Function
Rem ===========
 

File đính kèm

  • Ribbon_VBLibrary_VBA_VB6_Delphi.rar
    271.7 KB · Đọc: 8
Lần chỉnh sửa cuối:
xlmacr8.hlp là tập tin trước đó có tệp trợ giúp XLL bên trong
 
Học C API một thời gian nhưng không thay đổi các biểu tượng thanh công cụ, bất kỳ ý tưởng tốt 1705558364021.jpeg
 
125479980 đã viết:
Học C API một thời gian nhưng không thay đổi các biểu tượng thanh công cụ, bất kỳ ý tưởng tốt View attachment 298580
Nhấp chuột vào đây để mở rộng...
xem lại các bài trước và mã nguồn trong link bài số 1 là làm được

1/ sử dụng biểu tượng mặc định của Excel
2/ chèn hình ngoài vào trong Res xong dùng hàm keo nó nổi lên

2 cách trên thong thả dò đi là ra và code mẫu có hết đã lên mâm rồi còn ta mua 2 xị là xong thôi ... tự xào nấu đi mới thú vị --=0
 
Nếu thật sự đam mê chịu khó dò đi là ra vì mọi cái bài trên nói rất rõ rồi vì nó đã có sẳn còn ta dò xong tuỳ chỉnh lại theo sở thích...
qua đó xong mới biết và làm tiếp cái khác còn không thì sẻ bỏ cuộc chạy mất dép thôi _)()(-

Ngay trên Delphi khi ta cài đặt nó có hết các code mẫu... kể cả đọc và ghi dữ liệu từ xa qua Internet thông DataSnap chạy đa tầng đa dịch vụ ... không

ai chỉ dẫn cả đâu mà xem code mẫu xong hiểu nguyên lý , phương thức hoạt động của nó xong copy ra ngoài tuỳ chỉnh lại theo sở thích của mình

Tôi mất vài năm lôi ra xong cất vào không biết bao nhiều lượt .. khi rảnh nổi gió lại lôi ra... xong bây giờ viết API tạm ổn..

Tôi đang tập chung phát triển mở rộng Web Server đa tầng, đa dịch vụ ...
ai cần gì nếu Tôi biết thì Tôi sẻ chỉ cho các nơi mà Tôi lôi ra xong cất vào... xong tự mà dò lấy ... còn cái gì phổ biến thì Tôi sẻ úp cho Free xem như tham khảo thêm vậy ?!

Xem hình ... Addins TaskPane WebServer ... code có hết rồi chỉ thiết kế giao diện cho dễ nhìn, thân thiện, dễ sử dụng và phù hợp là xong ...

Khi biết viết AddIns trên Delphi thì rất tốt cho nhiều thứ mà thuần VBA không thể làm được và bảo mật tốt vv...

1705805358753.png
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Xin giúp đỡ lệnh làm Biên bản giao hàng
Trả lời
0
Đọc
1
hongthuy1992
H
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
5
Đọc
79
yaaasoo01
Y
C
  • Question
VBA copy 2 vùng dữ liệu từ 1 workbook này sang 2 vùng của workbook khác!
    • Phẫn nộ
Trả lời
10
Đọc
121
cuongbv2103
C
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
14
Đọc
298
hiv174
H
Tình nghĩa giang hồ
Hỗ trợ dữ liệu xen kẽ căn bằng theo quy luật.
Trả lời
7
Đọc
119
Phan Thế Hiệp
Phan Thế Hiệp
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom