اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


الردود الموصى بها

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

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

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

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

post-55950-0-54014300-1326831105_thumb.p

تم تعديل بواسطه 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


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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information