انشاء ملف بصيغة ‫Microsoft Office Excel Add-In‬

[الجازع]

اخواني الاعزاء

اود اضافة كود في شريط الاكسيل ولاستطيع فتحه من خلال اي ملف اكسيل اقوم بفتحه

ارجو ان يكون المطلوب واضح وتم ارفاق صوره للطلب

ولكم جزيل الشكر والتقدير..

تم تعديل يناير 17, 2012 بواسطه jazea

[محمد يحياوي]

الاخ الفاضل هذا مثال وظيفة اظافية احفظ الكود في موديل

Option Explicit

Public Const ToolBarName As String = "MyToolbarName"

'===========================================

Sub Auto_Open()

    Call CreateMenubar

End Sub

'===========================================

Sub Auto_Close()

    Call RemoveMenubar

End Sub

'===========================================

Sub RemoveMenubar()

    On Error Resume Next

    Application.CommandBars(ToolBarName).Delete

    On Error GoTo 0

End Sub

'===========================================

Sub CreateMenubar()

    Dim iCtr As Long

    Dim MacNames As Variant

    Dim CapNamess As Variant

    Dim TipText As Variant

    Call RemoveMenubar

    MacNames = Array("aaa")

    CapNamess = Array("AAA Caption")

    TipText = Array("AAA tip")

    With Application.CommandBars.Add

	    .Name = ToolBarName

	    .Left = 200

	    .Top = 200

	    .Protection = msoBarNoProtection

	    .Visible = True

	    .Position = msoBarFloating

	    For iCtr = LBound(MacNames) To UBound(MacNames)

		    With .Controls.Add(Type:=msoControlButton)

			    .OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)

			    .Caption = CapNamess(iCtr)

			    .Style = msoButtonIconAndCaption

			    .FaceId = 71 + iCtr

			    .TooltipText = TipText(iCtr)

		    End With

	    Next iCtr

    End With

End Sub

'===========================================

Sub AAA()

    MsgBox "aaa"

End Sub

'===========================================

ثم اغلق محرر الاكواد بكلمة سر

ثم احفظ الملف بامتداد xla

بعدها افتح اي ملف و استدعاء الوضيفة الاظافية

[الجازع]

اشكرك جزيل الشكر ولاكن هل من الممكن شرح الكود لو تكرمت

[الجازع]

للرفع

[محمد يحياوي]

اخي الكريم عذرا على التاخير

بفرض ان الماكرو الذي تريد تنفيذه هو star1 و star2

Sub star1()

	MsgBox "مرحبا"

End Sub

Sub star2()

	MsgBox "شكرا"

End Sub

فهذا الكود لعمل التول بار

Sub CreateMenubar()

	Dim iCtr As Long

	Dim MacNames As Variant

	Dim CapNamess As Variant

	Dim TipText As Variant

	Call RemoveMenubar

	MacNames = Array("star1", "star2")

	CapNamess = Array("star1", "star2")

	TipText = Array("star1", "star2")

	With Application.CommandBars.Add

		.Name = ToolBarName

		.Left = 200

		.Top = 200

		.Protection = msoBarNoProtection

		.Visible = True

		.Position = msoBarFloating

		For iCtr = LBound(MacNames) To UBound(MacNames)

			With .Controls.Add(Type:=msoControlButton)

				.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)

				.Caption = CapNamess(iCtr)

				.Style = msoButtonIconAndCaption

				.FaceId = 71 + iCtr

				.TooltipText = TipText(iCtr)

			End With

		Next iCtr

	End With

End Sub

طبعا يحتوي على التسميات و بعض الخصائص اما هذا الكود فهو لحذف التول بار

Sub RemoveMenubar()

	On Error Resume Next

	Application.CommandBars(ToolBarName).Delete

	On Error GoTo 0

End Sub

اما هذه الجملة في للتصريح بثابت و عو تصريح عام و تكتب قبل كتابة الكود

Public Const ToolBarName As String = "MyToolbarName"

اما هذين الكودين للتنفيذ و الحذف التلقائي

Sub Auto_Open()

	Call CreateMenubar

End Sub


Sub Auto_Close()

	Call RemoveMenubar

End Sub

ارجو انني وُفقت في الشرح

[الجازع]

اشكرك جزيل الشكر