هذه الاكواد تتعارض مع اوفيس 2016

[Ahmed mordy]

السلام عليكم 

هذه الاكواد تعطي خطأ في اوفيس 2016 ما هو السبب وما هو التعديل اللازم لكي تعمل علي هذا الاصدار وجميع الاصدارات 

 

Private Declare Function GetKeyboardLayoutName Lib "USER32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function LoadKeyboardLayout Lib "USER32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Private Declare Function GetKeyboardLayoutList Lib "USER32" (ByVal size As Long, ByRef Layouts As Long) As Long
Private Declare Function ActivateKeyboardLayout Lib "USER32" (ByVal HKL As Long, ByVal flags As Long) As Long

 *************
Private Declare Function GetActiveWindow Lib "USER32" () As Long
 
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long
 
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
 
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
 
Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean

*************

Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "USER32" (ByVal hWnd As Long) As Long
Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Const WS_SYSMENU = &H80000
 

[ابراهيم الحداد]

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

ضع هذه الدالة " PtrSafe " بين كلمتى "Declare" و "Function"

فى كل سطر تجد فيه هاتين الكلمتين

[Ahmed mordy]

استاذ زيزو اشكرك علي الافادة سوف اجربها لي سوءال بعد وضع هذه الدالة تعمل بشكل طبيعي في باقي الاصدارات ام ستتعارض معها 

وشكرا

[ناصر سعيد]

من فضلكم .. ما فائده هذه الداله ؟

[Ahmed mordy]

استاذ زيزو العجوز تسلم يداك بالفعل الدالة عملت علي تشغيل الكواد وتشغيل الملف علي اصدار 2016

ولكن تعارضت مع كود وظيفتة اظهار الباسورد علي شكل نجوم واعطني هذا الخطأ ما هو الحل مرفق صورة للخطأ بارك الله فيك لكي يعمل الملف كامل واعتزر علي الاطالة

استاذ ناصر تحياتي لك

الاستاذ زيزو العجوز هو اكثر واحد يفيدك ما هي وظيفة هذه الدالة ولكن المشكلة عندي ملف يعمل جيدا علي جميع الاصدارات ما عدا اصدار 2016 يتعارض مع الاكواد الموجودة في المشاركة الاولي وتم الحل علي يد الاستاذ زيزو وباقي جزئ بسيط ان شاء الله يكمل الحل علي يد الاستاذ زيزو بارك الله فية

[Ahmed mordy]

للرفع

[Ahmed mordy]

للرفع 

[ناصر سعيد]

من فضلكم .. ما فائده هذه الداله ؟

اخي الكريم استاذ احمد

الى ان يرد علينا الاستاذ الكبير زيزو

انت بتستخدم هذه الداله في اي شيء ( عشان الداله تعمل ايه )

[Ahmed mordy]

السلام عليكم 

استاز ناصر بارك الله في حضرتك انظر حضرتك الي المشاركة الاولي هذا جزئ من اكواد تعمل في ملف عندي اما المشكلة فهي نتيجة لتنصيب اوفيس اصدار 2016 علي وندوز 64 ولكن هذا الملف يعمل جيدا علي جميع اصدارات الاوفيس من 2007 الي اوفيس 2013 وتم طرح المشكلة وافادني الاستاز زيزو بارك الله فيه بالداله وتم اضافة الدالة علي حسب توجيهات الاستاز زيزو وهي تعمل الان جيدا الحمد لله باقي الكود الموجود في المشاركة الرابعة وهو كود خاص بإظهار رقم الباسورد علي شكل نجوم 

[Ahmed mordy]

السادة الافاضل هذا الكود يتعارض مع اوفيس 2016 حتي بعد اضافة دالة ptrsafe ارجو الافادة وما هو الحل بارك الله فيكم

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

[Ahmed mordy]

للرفع

[maxstreets]

معي نقس المشكلة 

Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long)