هل هناك إمكانية لدمج هذه الأكواد معاً ؟؟

[triste]

السلام عليكم ورحمة الله وبركاته،،

الأخوة الكرام :

أريد أن يتم إظهر كلمة السر لتنفيذ (ماكرو) على شكل نجوم ، و أعلم أن هناك أكثر من موضوع بالمنتدى للإجابة عن أسئلة مماثلة و مرفق بها هذه الأكواد ، و لكنها طويلة و لا يستطيع المبتدئ - مثلى - التعامل معها ، خاصة لو كان الأمر يتطلب إدماجها مع كود موجود أصلاً بالفعل - كالذى لدى بالفعل و الذى يقوم بوظيفتى إظهار ال inputbox الذى يتم إدخال كلمة السر به و كذا فك الحماية عن جميع أوراق كتاب العمل دفعة واحدة بمجرد إدخال كلمة السر -

و من ناحية أخرى فقد فكرت أنه لو كان هناك طريقة لعمل ماكرو للتحكم بلون ال (Font) الذى يتم كتابة كلمة السر به داخل ال inputbox و ذلك حتى يتعذر مجرد معرفة طول كلمة السر هذه إذا تم تحويل هذا اللون لنفس لون الخلفية التى يكتب عليها .

هذا هو الكود الموجود أصلاً لدى (السابق الإشارة إليه) :

Sub UNPROTECT()

x = InputBox("xxxx", "please enter the password")

If x = "zzzz" Then

Dim password As Worksheet

For Each password In ActiveWorkbook.Worksheets

password.UNPROTECT password:="zzzz"

Next password

Else: Exit Sub

End If

End Sub

و هذا هو كود تحويل (كلمة السر إلى نجوم) و هو - كما ترون ليس سهلاً:

Option Explicit

'////////////////////////////////////////////////////////////////////

'Password masked inputbox

'Allows you to hide characters entered in a VBA Inputbox.

'

'Code written by Daniel Klann

'March 2003

'////////////////////////////////////////////////////////////////////

'API functions to be used

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _

ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _

(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _

ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _

(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _

ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _

ByVal lpClassName As String, _

ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Constants to be used in our API functions

Private Const EM_SETPASSWORDCHAR = &HCC

Private Const WH_CBT = 5

Private Const HCBT_ACTIVATE = 5

Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim RetVal

Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then

NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

Exit Function

End If

strClassName = String$(256, " ")

lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then 'A window has been activated

RetVal = GetClassName(wParam, strClassName, lngBuffer)

If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox

'This changes the edit control so that it display the password character *.

'You can change the Asc("*") as you please.

SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0

End If

End If

'This line will ensure that any other hooks that may be in place are

'called correctly.

CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _

Optional YPos, Optional HelpFile, Optional Context) As String

Dim lngModHwnd As Long, lngThreadID As Long

lngThreadID = GetCurrentThreadId

lngModHwnd = GetModuleHandle(vbNullString)

hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)

UnhookWindowsHookEx hHook

End Function

فهل هناك طريقة :

إما للتحكم باللون ، أو لدمج الكودين معاً ؟؟

تم تعديل فبراير 14, 2006 بواسطه triste

[triste]

هل من رد

هل من مجيب

هل من أحد ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

[triste]

ما الذى حدث للمنتدى !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

ألم يعد هناك من يرد على الموضوعات !!!!!!!!!!!!!!!!!!!!!!!!!!!!

[triste]

أليس هذا هو منتدى أوفيسنا ، !!!!!!!!!!!!!!!!!!!!!!!!!!

أم أننى أخطأت العنوان

[halwim]

تحية عطرة للجميع

بغض النظر عن المثال السابق بودي الاجابة عن طريقة التعامل مع أكثر من كود في مكان واحد على محرر أكواد الفيجول بيسك والموديل ........... كيف أرجو شرح الطريقة ؟؟

يعني كيف أجمع بين كودين ؟؟ هل يلزم وضع وسم بداية ونهاية لكل كود أم يكفي واحد للجميع أنا جربت فلم يظبط معي .

[خالد نور]

ضع ملف اخى العزيز لتجد الآجابة ان شاء الله من الآخرين

و(أبتسم وتفائل فأنت فى منتدى أوفيسنا )

ولم تخطاء العنوان

[halwim]

ضع ملف اخى العزيز لتجد الآجابة ان شاء الله من الآخرين

و(أبتسم وتفائل فأنت فى منتدى أوفيسنا )

ولم تخطاء العنوان

شكرا أخي على اهتمامك ومرورك .......... حصلت على رابط ربما يكون في صميم المطوب ولكن كما قلت ينقصني معرفة التطبيق

لذلك رأيت من الأفضل وضع رابط ذلك الموضوع لكي يمكن الإستفادة منه وهو بعنوان وضع أكثر من كود للأستاذ حسام نور :

http://www.officena.net/ib/index.php?act=S...;f=51&t=616

المطلوب / تحميل الملف trakumy.rar من الرابط التالي ووضع الكودين فيه :

http://www.officena.net/ib/index.php?act=A...ost&id=4608

الكود الأول الجمع :

http://www.officena.net/ib/index.php?act=A...ost&id=4403

الكود الثاني الطرح :

http://www.officena.net/ib/index.php?act=A...ost&id=4534

بحيث تعمل طريقتا الجمع والطرح الذاتي في ملف واحد في المدى المحدد لهما كما لوكان قبل الدمج ولو تكرمت بعمل فورم الإدخال لكان أكمل ولكن عمل هذا الفورم للترحيل ليس عائقا ......... أهم شيء جمع روتين الكودين في ورقة .

تم تعديل يوليو 13, 2006 بواسطه halwim

[halwim]

أتمنى أن يكون طلبي واضح وإذا لم يكن واضح فأنا بالخدمة للشرح أكثر

[halwim]

في الإنتظار