jjafferr

وعليكم السلام 🙂 ما شاء الله عليك اخوي اباجودي ، جمعت الفريق كله في مكان واحد ، وفي منهم اللي ما يحب يلعب مع صاحبه 🙂 كنت اتمنى ان اقدم شرح ، ولكن هناك الكثير والكثير من التعديلات ، فسأجعلك تتابع التعديلات بنفسك ، واذا في اي سؤال خاص ، ان شاء الله اقدر ارد عليك 🙂 جعفر 8.1.Utilities Hide Ico Minimze To SysTray.accdb.zip

السلام عليكم 🙂 شفت بعض الاوقات لما تحس ان مخك ما يشتغل ، هذا انا الحين 😁 بما انك حددت وين المشكلة في برنامجك ، فانا عملت لك هذه المساعدة : وحدة نمطية اسمها mod_Global_Variables ، وفيها نحتفظ بنوع المستخدم في الحقل ppos ، ويمكن للبرنامج قراءته من اي مكان في البرنامج ، وعلى اساس قيمة ppos ، فقد وضعتها في حدث "الحالي" للنموذج ، فالرجاء وضعها بالطريقة الصحيحة (قلت لك مخي ما يشتغل 🙂) . جعفر 1417.moh.accdb.zip

شكرا اباجودي على هذه الكلمات الجميلة ، ونسأل الله سبحانه وتعالى ان يقدرنا على المزيد من العطاء 🙂 جعفر

عفوا ، رجاء ارسال ملاحظاتكم للرابط اعلاه ، الى مايكروسوفت مباشرة 🙂 جعفر

السلام عليكم 🙂 الله ان شاء الله يسهل عليك ، وقوم بالسلامة ان شاء الله 🙂 من الصعب التغلب على سرعة اباجودي 🙂 هذه محاولتي: الاستعلام: الحقل ALL ينادي الوحدة النمطية Count_Chr ، ويرسل معها قيمة الحقل Enter ، . الحقل ALL يستلم عدد مرات وجود الحقول الاخرى ، وبين كل قيمة حقل ، وضعت حرف ابجدي متسلسل ، حتى استطيع من خلال الاستعلام ان: انادي الوحدة النمطية مرة واحدة فقط لكل سجل ، ثم نفكك قيمة الحقل ALL الى بقية الحقول (وعلشان تجربة التفكيك ، قمت بعمل وحدة نمطية اسمها myTest ، وكل حقل اعطيته رقم a1 ثم a2 ... وهكذا) . الآن وعندك هذه القيم في استعلام ، وفي وحدة نمطية ، يمكنك الاستفادة منه بالطريقة التي تريدها 🙂 هذه هي الوحدات النمطية: Public Function Count_chr(str As String) As String 'NA = رقم عربي 'CA1 = حرف عربي 'NE = رقم انجليزي 'CE1 = حروف انجليزي كبيرة 'CE2 = حروف انجليزي صغيرة 'B1 = اشكال و رموز Dim i As Integer Dim NA As Integer, CA1 As Integer, NE As Integer, CE1 As Integer, CE2 As Integer, B1 As Integer Dim Each_Letter As String For i = 1 To Len(str) Each_Letter = Mid(str, i, 1) If Asc(Each_Letter) >= 48 And Asc(Each_Letter) <= 57 Then 'English Numbers NE = NE + 1 ElseIf Asc(Each_Letter) >= 65 And Asc(Each_Letter) <= 90 Then 'English, Capital letters CE1 = CE1 + 1 ElseIf Asc(Each_Letter) >= 97 And Asc(Each_Letter) <= 122 Then 'English, Samall letters CE2 = CE2 + 1 ElseIf (AscW(Each_Letter) >= 1569 And AscW(Each_Letter) <= 1594) Or _ (AscW(Each_Letter) >= 1600 And AscW(Each_Letter) <= 1610) Then 'Arabic Letters CA1 = CA1 + 1 ElseIf AscW(Each_Letter) >= 1632 And AscW(Each_Letter) <= 1641 Then 'Arabic Numbers NA = NA + 1 Else 'Symbols B1 = B1 + 1 End If Next i 'send the result, seperated with letters, 'then parse the result into its 6 components (see Function myTest) Count_chr = NA & "A" & CA1 & "B" & NE & "C" & CE1 & "D" & CE2 & "E" & B1 & "F" 'Debug.Print NA & vbTab & CA1 & vbTab & NE & vbTab & CE1 & vbTab & CE2 & vbTab & B1 & vbTab & str End Function Function myTest() Dim a1 As String, a2 As String, a3 As String, a4 As String, a5 As String, a6 As String, ALL As String ALL = "1A22B333C4444D55555E666666F" a1 = Mid(ALL, 1, InStr(ALL, "A") - 1) a2 = Mid(ALL, InStr(ALL, "A") + 1, InStr(ALL, "B") - (InStr(ALL, "A") + 1)) a3 = Mid(ALL, InStr(ALL, "B") + 1, InStr(ALL, "C") - (InStr(ALL, "B") + 1)) a4 = Mid(ALL, InStr(ALL, "C") + 1, InStr(ALL, "D") - (InStr(ALL, "C") + 1)) a5 = Mid(ALL, InStr(ALL, "D") + 1, InStr(ALL, "E") - (InStr(ALL, "D") + 1)) a6 = Mid(ALL, InStr(ALL, "E") + 1, InStr(ALL, "F") - (InStr(ALL, "E") + 1)) End Function . للحصول على الارقام الصحيحة للامر Asc (للارقام والحروف الانجليزية) و AscW (للارقام والحروف العربية) ، استعنت بالصور الموجودة في هذا الموضوع: https://www.officena.net/ib/topic/104923-قراءة-وتفكيك-بيانات-الحقل-الى-حقول/ ولكني لم افهم قصدك في آخر سجلين: المطوب لايتكرر و يسمح له بتكرر مرة واحدة جعفر 1408.Parse_a_Value.accdb.zip

السلام عليكم شباب 🙂 طريقتي: . وفي حدث "بعد تحديث" Date Start : Private Sub Date_Start_AfterUpdate() Me.cmb_3Dates.RowSourceType = "Value List" Me.cmb_3Dates.RowSource = Empty Me.cmb_3Dates.AddItem Me.Date_Start Me.cmb_3Dates.AddItem Me.Date_Start + 1 Me.cmb_3Dates.AddItem Me.Date_Start + 2 End Sub جعفر 1416.3Dates.accdb.zip

شكرا جزيلا اخوي موسى على هذا الاطراء 🙂 الحمدلله ، هذا من فضل ربي 🙂 جعفر

وعليكم السلام 🙂 رجاء النظر الى جدول ascii هذا ، والذي فيه جميع رموز لوحة المفاتيح الانجليزية: . بمعنى آخر ، كل زر تنقر عليه على لوحة المفاتيح (حرف يمكنك رؤيته وقراءته) ، يتم ترجمتها في الكمبيوتر ، حسب طلب البرنامج الذي تستعمله ، الى واحدة من هذه الارقام والرموز 🙂 من الجدول ، انظر الى الحقل Dec الرقم 10 و 13 ، والقيم التي تقابلها من الحقل Chr (او Char) (ومعناها) ، فهذه القيم هي التي تقرر الانتقال الى السطر التالي ، هكذا chr(10) و chr(13) 🙂 هذه القيم تعتمد على البرنامج الذي يستخدمها ، فهناك من يستعمل 10 وهناك من يستخدم 13 وهناك من يستخدمهم معا 🙂 رجاء تنظر الى المشاركات في هذا الرابط حتى يصير عندك إلمام كامل بالموضوع: . وفي محرر الاكواد VBE ، يمكننا استعمال مسميات هذه الرموز بلغة الاكسس (والتي تم اخذها من لغة Visual Basic ، VB) ، بدلا من الارقام اعلاه ، في محرر الاكواد ، ابحث عن vb constants ، وسترى قائمة المسميات . وعند النقر على الرابط الذي عليه السهم (الاوامر التي تخص موضوعنا) . نرى ان خياراتنا لجواب سؤالك اصبحت: الطريقة 2 او الطريقة 1 Me.text3=Me.text1 & vbNewLine & Me.text2 Me.text3=Me.text1 & chr(13) & chr(10) & Me.text2 Me.text3=Me.text1 & vbCrLF & Me.text2 Me.text3=Me.text1 & chr(13) & chr(10) & Me.text2 Me.text3=Me.text1 & vbLF & Me.text2 Me.text3=Me.text1 & chr(10) & Me.text2 Me.text3=Me.text1 & vbCr & Me.text2 Me.text3=Me.text1 & chr(13) & Me.text2 جعفر

وبصحة وسلامة ان شاء الله 🙂 جعفر

هل هو نموذج فرعي؟

لا ابدا 🙂 جعفر

عمل رائع 🙂 وبحاجة ماسة له في برامجنا 🙂 جعفر

وعليكم السلام ) واهلا وسهلا بك في المنتدى: للإستفادة القصوى من المنتدى ، رجاء قراءة قوانين المنتدى : اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة بدل كلمة Form ، استخدم .Me ، هكذا: If Form_دخول.tap = "مستخدم" Then me.AllowAdditions = False me.AllowDeletions = False me.AllowEdits = False MsgBox "صلاحيات محدوده", vbInformation, "اهلا و سهلا" End If . جعفر

حذفت المرفق القديم من المشاركة ، ولكن للاسف بقية ايقونته ، فحذفتها الآن 🙂 ولكن الملف الجديد كان ولا يزال هناك 🙂 جعفر

السلام عليكم 🙂 بسبب امكانية فتح الشفت من برنامج خارجي ، فيكون بإمكانك الدخول على جداول Accde او MDE ، لهذا السبب لا تضع كلمة سر البرنامج الآخر في الجدول ، بينما تقدر ان تضع كلمة سر البرنامج الآخر في الكود ، لأن البرنامج بصيغة Accde او MDE لا يوجد به كود 🙂 مافي داعي لقفل الكود بالباسورد ، لأنه اصلا لا يوجد كود في هذه الصيغة 🙂 جعفر

شكرا على التنبيه اخوي عبدالله 🙂 تم إضافة الحل في المشاركة الاولى في الموضوع ، كما تم تغيير المرفق في الرابط الذي ذكرته : جعفر

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

اخوي ازهر ، رجاء تجرب هاي: بدل هذا السطر ShellEx "C:\Program Files\Common Files\Microsoft Shared\ink\TabTip.exe", , True استعمل هذه الاسطر If IsWindows_64bit Then Wow64EnableWow64FsRedirection False ShellEx "C:\Program Files\Common Files\Microsoft Shared\ink\TabTip.exe", , True Wow64EnableWow64FsRedirection True Else ShellEx "C:\Program Files\Common Files\Microsoft Shared\ink\TabTip.exe", , True End If ثم اخبرنا اذا الزر الثاني اشتغل او لا !! احيانا يجب ان تحاول مرتين على الزر الثني ، يعني انقر مرة وانتظر ، واذا ما اشتغل ، انقر مرة ثانية 🙂 جعفر

شكرا جزيلا اخوي @ناقل🙂 جعفر

ولو اني لا احبذ هذه الطريقة ، لأن الوحدات النمطية السابقة كانت مرتبة ، كل وحدة تخص عملها ، ويكون اسهل معرفة مكان الخطأ (ان وُجد) ! وبدون تحمل المسؤولية ، تفضل 🙂 Option Compare Database Option Explicit #If VBA7 And Win64 Then '64 bits Public Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr Public Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr #Else '32 bits Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Public Declare Function GetCurrentProcess Lib "kernel32" () As Long #End If Public Declare PtrSafe Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" (ByVal Enable As Boolean) As Boolean Public Declare PtrSafe Function IsWow64Process Lib "kernel32" (ByVal hProc As Long, bWow64Process As Long) As Long ' ' Module to provide metrics information (from GetSystemMetrics) and conversions - ' twips <-> pixel conversions ' __________________________________________________________________________________ ' CREATED: 6 march 2004, Paul J. Champion ' NEEDS: ' __________________________________________________________________________________ ' HISTORY ' __________________________________________________________________________________ ' OVERVIEW Public Enum AccessSpecifications maxSectionHeight = 31680 maxFormWidth = 31680 maxReportWidth = 31680 RecordSelectorWidth = 300 End Enum Public Const DefaultMargin = 60 '60 twips = 0.1 cm, a nice small but clear margin 'Public Const AccessSpecifications.maxSectionHeight = 31680 Private Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type Public Type Size Width As Long Height As Long End Type ' TWIPS to PIXELS api declares & constants '############################################### 'Conditional compilation #If VBA7 Then 'use PtrSafe & LongPtr Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function apiGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function apiGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If '############################################### Private Const HWND_DESKTOP As Long = 0 Private Const LOGPIXELSX As Long = 88 Private Const LOGPIXELSY As Long = 90 Public Enum SystemConstants SM_CXSCREEN = 0 SM_CYSCREEN = 1 SM_CXVSCROLL = 2 SM_CYHSCROLL = 3 SM_CYCAPTION = 4 SM_CXBORDER = 5 SM_CYBORDER = 6 SM_CXDLGFRAME = 7 SM_CYDLGFRAME = 8 SM_CYVTHUMB = 9 SM_CXHTHUMB = 10 SM_CXICON = 11 SM_CYICON = 12 SM_CXCURSOR = 13 SM_CYCURSOR = 14 SM_CYMENU = 15 SM_CXFULLSCREEN = 16 SM_CYFULLSCREEN = 17 SM_CYKANJIWINDOW = 18 SM_MOUSEPRESENT = 19 SM_CYVSCROLL = 20 SM_CXHSCROLL = 21 SM_DEBUG = 22 SM_SWAPBUTTON = 23 SM_RESERVED1 = 24 SM_RESERVED2 = 25 SM_RESERVED3 = 26 SM_RESERVED4 = 27 SM_CXMIN = 28 SM_CYMIN = 29 SM_CXSIZE = 30 SM_CYSIZE = 31 SM_CXFRAME = 32 SM_CYFRAME = 33 SM_CXMINTRACK = 34 SM_CYMINTRACK = 35 SM_CXDOUBLECLK = 36 SM_CYDOUBLECLK = 37 SM_CXICONSPACING = 38 SM_CYICONSPACING = 39 SM_MENUDROPALIGNMENT = 40 SM_PENWINDOWS = 41 SM_DBCSENABLED = 42 SM_CMOUSEBUTTONS = 43 SM_CMETRICS = 44 SM_CXSIZEFRAME = SM_CXFRAME SM_CYSIZEFRAME = SM_CYFRAME SM_CXFIXEDFRAME = SM_CXDLGFRAME SM_CYFIXEDFRAME = SM_CYDLGFRAME SM_TABLETPC = 86 End Enum 'this is do with the mdi client '############################################### #If VBA7 Then 'use PtrSafe & LongPtr Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Rect) As Long Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Rect) As Long Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As Long #Else Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long #End If '############################################### '############################################### #If VBA7 Then 'use PtrSafe & LongPtr Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" _ (ByVal hwnd As LongPtr, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As Long #Else Private Declare Function apiShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As Long #End If '############################################### Public strApp As String ' Error handling Dim ErrorSource As String ' Public Sub ShellEx(ByVal Path As String, Optional ByVal Parameters As String, Optional ByVal HideWindow As Boolean) If Dir(Path) > "" Then apiShellExecute 0, "open", Path, Parameters, "", IIf(HideWindow, 0, 1) Else MsgBox "Can't find application" End If End Sub Public Function RunOSK() 'opens on screen keyboard if opened in tablet mode 'To test it on a standard PC, disable the 'If ...End If ''If modMetrics.System(SM_TABLETPC) Then ' apiShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1 ' ' ShellEx "c:\windows\system32\osk.exe", , True ' strApp = "osk.exe" ''End If If IsWindows_64bit Then Wow64EnableWow64FsRedirection False apiShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1 'Shell "cmd /c osk", 0 Wow64EnableWow64FsRedirection True Else 'Shell "cmd /c osk", 0 apiShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1 End If strApp = "osk.exe" End Function Public Function OpenTabTip() 'opens tablet screen keyboard in tablet mode 'To test it on a standard PC, disable the 'If ...End If 'If modMetrics.System(SM_TABLETPC) Then ShellEx "C:\Program Files\Common Files\Microsoft Shared\ink\TabTip.exe", , True strApp = "TabTip.exe" 'End If End Function Sub TerminateApp() '--------------------------------------------------------------------------------------- ' Terminates the exe process specified. ' Uses WMI (Windows Management Instrumentation) to query all running processes ' then terminates ALL instances of the exe process held in the variable strTerminateThis. '--------------------------------------------------------------------------------------- Dim strTerminateThis As String 'The variable to hold the process to terminate Dim objWMIcimv2 As Object, objProcess As Object, objList As Object Dim intError As Integer If Nz(strApp, "") = "" Then Exit Sub 'Process to terminate – you could specify and .exe program name here strTerminateThis = strApp 'Connect to CIMV2 Namespace and then find the .exe process Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'") For Each objProcess In objList intError = objProcess.Terminate 'Terminates a process and all of its threads. 'Return value is 0 for success. Any other number is an error. If intError <> 0 Then Exit For Next 'ALL instances of exe (strTerminateThis) have been terminated Set objWMIcimv2 = Nothing Set objList = Nothing Set objProcess = Nothing End Sub ' Returns a size variable containing the width and height of the MDI Client area ' for Microsoft Access at that moment in time. ' _____________________________________________________________________________ ' ARGUMENTS ' InPixels TRUE - return the size in pixels ' FALSE (default) - return the size in twips Public Function AccessAppInsideSize _ (Optional InPixels As Boolean = False) _ As Size Dim rectMDIClient As Rect Dim sizePixels As Size, sizeTwips As Size Dim WidthInPixels As Long, HeightInPixels As Long ' ' Initialize error handling On Error Resume Next ' if an error occurs this routine will return a size of 0,0 ' ' Open a dummy form or use an existing form so we can grab the parent of its window handle (hWnd) Dim F As New Form Dim bCloseForm As Boolean Dim bFoundNonPopUpForm As Boolean If Forms.count > 0 Then ' Find non-PopUp form Dim frm As Access.Form For Each frm In Forms If Not frm.PopUp Then Set F = frm bCloseForm = False bFoundNonPopUpForm = True Exit For End If Next End If If Not bFoundNonPopUpForm Then Set F = CreateForm bCloseForm = True End If ' ' Get the screen coordinates and window size of the rectMDIClient window GetWindowRect GetParent(F.hwnd), rectMDIClient ' Close dummy form without saving If bCloseForm Then DoCmd.Close acForm, F.Name, acSaveNo ' ' Calculate size in pixels sizePixels.Width = rectMDIClient.Right - rectMDIClient.Left - modMetrics.System(SM_CXFRAME, False) sizePixels.Height = rectMDIClient.Bottom - rectMDIClient.Top - modMetrics.System(SM_CYFRAME, False) ' ' Return correct values If InPixels Then ' return result as is AccessAppInsideSize = sizePixels Else ' convert result to twips sizeTwips.Width = modMetrics.converttoTwipsX(sizePixels.Width) sizeTwips.Height = modMetrics.converttoTwipsY(sizePixels.Height) AccessAppInsideSize = sizeTwips End If End Function ' Converts twips to pixels ' __________________________________________________________________________________ ' Public Function converttoPixelX(ByVal TwipsX As Long) As Long Dim lngDC As Long, intPerPixelX As Integer lngDC = GetDC(HWND_DESKTOP) intPerPixelX = 1440 / GetDeviceCaps(lngDC, LOGPIXELSX) ReleaseDC HWND_DESKTOP, lngDC converttoPixelX = TwipsX / intPerPixelX End Function ' Converts pixels to twips ' __________________________________________________________________________________ ' Public Function converttoPixelY(ByVal TwipsY As Long) As Long Dim lngDC As Long, intPerPixelY As Integer lngDC = GetDC(HWND_DESKTOP) intPerPixelY = 1440 / GetDeviceCaps(lngDC, LOGPIXELSY) ReleaseDC HWND_DESKTOP, lngDC converttoPixelY = TwipsY / intPerPixelY End Function ' Converts pixels to twips ' __________________________________________________________________________________ ' Public Function converttoTwipsX(ByVal PixelX As Long) As Long Dim lngDC As Long, intPerPixelX As Integer lngDC = GetDC(HWND_DESKTOP) intPerPixelX = 1440 / GetDeviceCaps(lngDC, LOGPIXELSX) ReleaseDC HWND_DESKTOP, lngDC converttoTwipsX = intPerPixelX * PixelX End Function ' Converts pixels to twips ' __________________________________________________________________________________ ' Public Function converttoTwipsY(ByVal PixelY As Long) As Long Dim lngDC As Long, intPerPixelY As Integer lngDC = GetDC(HWND_DESKTOP) intPerPixelY = 1440 / GetDeviceCaps(lngDC, LOGPIXELSY) ReleaseDC HWND_DESKTOP, lngDC converttoTwipsY = intPerPixelY * PixelY End Function ' Converts point size (from a font) to twips ' __________________________________________________________________________________ ' Public Function converttoTwipsYFromPoint(PointSize As Long) As Long Dim lngDC As Long, intPerPixelY As Integer lngDC = GetDC(HWND_DESKTOP) intPerPixelY = 1440 / GetDeviceCaps(lngDC, LOGPIXELSY) converttoTwipsYFromPoint = intPerPixelY * Int(PointSize * GetDeviceCaps(lngDC, LOGPIXELSY) / 72) ReleaseDC HWND_DESKTOP, lngDC End Function ' Returns the dimensions of the screen, in twips or pixels ' _____________________________________________________________________________ ' Public Function MetricsScreenHeight _ (Optional ConvertToTwips As Boolean = True) MetricsScreenHeight = System(SM_CYSCREEN, ConvertToTwips) End Function Public Function MetricsScreenWidth _ (Optional ConvertToTwips As Boolean = True) MetricsScreenWidth = System(SM_CXSCREEN, ConvertToTwips) End Function ' Returns a result of GetSystemMetrics in twips or pixels ' _____________________________________________________________________________ ' Public Function System(SystemMetricRequired As SystemConstants, Optional ConvertToTwips As Boolean = True) As Variant If ConvertToTwips Then Select Case SystemMetricRequired Case SM_CYSCREEN, SM_CYHSCROLL, SM_CYCAPTION, _ SM_CYBORDER, SM_CXDLGFRAME, SM_CYDLGFRAME, _ SM_CYVTHUMB, SM_CYICON, SM_CYCURSOR, _ SM_CYMENU, SM_CYFULLSCREEN, SM_CYKANJIWINDOW, _ SM_CYVSCROLL, SM_CYMIN, SM_CYSIZE, _ SM_CYFRAME, SM_CYMINTRACK, SM_CYDOUBLECLK, _ SM_CYICONSPACING, SM_CYSIZEFRAME, SM_CYFIXEDFRAME System = converttoTwipsY(apiGetSystemMetrics(SystemMetricRequired)) Case Else: System = converttoTwipsX(apiGetSystemMetrics(SystemMetricRequired)) End Select Else System = apiGetSystemMetrics(SystemMetricRequired) End If End Function ' 'use it like this: ' 'Private Sub Command1_Click() ' If Is64bit Then ' Wow64EnableWow64FsRedirection False ' ShellExecute 0, "open", "osk.exe", "", "", vbNormalFocus ' Wow64EnableWow64FsRedirection True ' Else ' ShellExecute 0, "open", "osk.exe", "", "", vbNormalFocus ' End If 'End Sub Public Function IsWindows_64bit() As Long If GetProcAddress(GetModuleHandle("kernel32"), "IsWow64Process") > 0 Then IsWow64Process GetCurrentProcess(), IsWindows_64bit End If End Function جعفر

هذه المعلومة غير دقيقة ، لأنه يشتغل عندي 🙂

لوسمحت تنقر نقرتين على الملف ، شوف اذا يفتح ؟ نعم ، وتقدر ان تجمعها كلها في وحدة نمطية واحدة 🙂 جعفر

رجاء تبحث عن الملف TabTip.exe في جهازك وتخبرنا مساره ، علشان نشوف موضوع الزر الثاني 🙂 جعفر

على حدث نقر الزر الاول ، احذف الكود ، ثم اكتب: RunOSK جعفر

شكرا جزيلا 🙂 طربقة العمل تقتضي انه لما تنقر على حقل النص ، تظهر لوحة المفاتيح ، فهل قصدك تريدها ثابته على الشاشة دائما ؟ جعفر