المطلوب تكرار حقل داخل تقرير

**jjafferr** · يناير 10, 2017

2 ساعات مضت, ابوخليل said:

1- ازالة الكتابات الزائدة في اعلى الصفحة واسفلها

2- ضبط الهوامش العلوي والسفلي من حد الورقة = 1.3 سم واليمين واليسار = 0.7 سم

والسبب بضبط الهوامش حتى تنطبق الكتابة تماما على الملصقات

السلام عليكم أخوي ابوخليل :smile:

لما تطلع لك نافذة الطباعة:

524.2.Clipboard02.jpg

.

1. تقدر تختار عدد صفحات الطباعة:

524.2.Clipboard03.jpg

.

2. عندك الخيارات ، حجم الصفحة ، الهوامش (لاحظ الهوامش عندي بالبوصة Inch حسب اعدادات الكمبيوتر) ، والكتابات في اعلا الصحة واسفلها ،

وجميع هذه الاعدادات تضبطها لمرة واحدة فقط ، وسيحفظها الكمبيوتر للمرات التالية:

524.2.Clipboard04.jpg

.

جعفر

هذه صورة من الكود الموجود في البرنامج:

524.2.Clipboard05.jpg

.

1. نستطيع تغيير نوع الخط Font من هنا ،

2. وحجم الخط ،

3. انا كنت اعمل على عمل حد وبرواز حول الحقول ، ولون البرواز الاسود هو dddddd# ، ثم قمت بتعطيل هذا الكود ، واستبدلت اللون باللون الابيض FFFFFF# ، واستعملت هذا الكود :smile:

جعفر

**ابوخليل** · يناير 10, 2017

ما تركت صغيرة الا وبينتها بالشرح وبالصور

أحسنت ، وأجدت ..

أحسن الله اليك ، وأدام عليك نعمه

**jjafferr** · يناير 10, 2017

13 دقائق مضت, ابوخليل said:

ما تركت صغيرة الا وبينتها بالشرح وبالصور

أحسنت ، وأجدت ..

أحسن الله اليك ، وأدام عليك نعمه

أحسن الله الينا وادام نعمه علينا جميعا ان شاء الله ، ومن احببنا :smile:

جعفر

**jjafferr** · يناير 11, 2017

السلام عليكم :smile:

اختم الموضوع بجمع 3 طرق كما سبق ، ولكن باختلافات بسيطة ،

واعرض هنا كيفية عمل جدول مؤقت خارج قاعدة البيانات (طبعا الجدول سيكون في قاعدة بيانات خارجية مؤقتة) ، ثم كيف ربط هذا الجدول المؤقت ببرنامجنا الحالي :smile:

- تم حذف الجدول المؤقت من البرنامج ،

1. تم إضافة وحدات نمطية 2 (طبعا يمكن الاستغناء عنهم ، وذلك بضمهم لكود النموذج) ،

الوحدة النمطية الاولى فيها كود لمناداة بعض مجلدات الوندوز المهمة ، ومنها مجلد Temp ، والذي سنتعامل معه لجميع البرامج/الملفات المؤقته ،

والوحدة النمطية الثانية لعمل قاعدة البيانات الخارجية المؤقته ،

2. تم تقسيم عدد الاسطر الى عدد الاسطر والاعمدة ، ليتناسب مع عمل صفحة الانترنت بلغة HTML ،

3. سيقوم بعمل التقرير بواسطة صفحة انترنت بلغة HTML ،

4. سوف يفتح المجلد Temp وسيكون مختار ملف الانترنت الذي تم عمله بالزر رقم 3 ،

5. عمل التقرير بطريقة الاستاذ رمهان ، ولكن باستخدام جدول خارجي مؤقت ،

6. عمل التقرير بطريقة الاستاذ صالح ، ولكن باستخدام جدول خارجي مؤقت ، وهذه الطريقة هي الطريقة المستخدمة غالبا لمعظم الجداول المؤقته ،

7. يفتح المجلد Temp وسيكون مختار قاعدة البيانات الخارجية المؤقتة ، والتي تم عملها بالزرين رقم 5 و 6 ،

524.3.Clipboard01.jpg

.

التقرير ، ونلاحظ انه لا يوجد له مصدر للبيانات (حيث ان المصدر يعتمد على استخدامنا للزر 5 او 6 ) ،

والتقرير كما عمله اخونا ابوخليل ،

524.3.Clipboard02.jpg

.

هذا كود التقرير:

- عند فتحة ، يأخذ مصدر البيانات من المتغير mySQL والذي هو عبارة عن استعلام بصيغة SQL ، والذي يؤخذ من الجدول المؤقت (وسنرى في النموذج هذا الكود) ،

- وعند اغلاق التقرير ، نغلق الجدول المؤقت ، وبقية الاستعلامات المحلية التي عُملت على اساسه ،


Private Sub Report_Open(Cancel As Integer)
    
    Me.RecordSource = mySQL
    DoCmd.Maximize
End Sub

Private Sub Report_Unload(Cancel As Integer)
On Error GoTo err_Report_Unload

    Dim OtherDB As Object

    qrydef.Close
    CurrentDb.Close
    
    'close the temp_DB
    sOther = GetWinTemp & "\temp_DB.mdb"
    Set OtherDB = GetObject(sOther)
    OtherDB.Application.Quit

Exit Sub
err_Report_Unload:

    If Err.Number = 424 Then
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

.

الوحدة النمطية لمناداة بعض مجلدات الوندوز المهمة ، ومنها مجلد Temp ، والذي سنتعامل معه لجميع البرامج/الملفات المؤقته ،


'Return Windows directory
Function GetWinDir()
Set FS = CreateObject("Scripting.FileSystemObject")
GetWinDir = FS.GetSpecialFolder(WindowsFolder)
Set FS = Nothing
End Function

'Return Windows/System directory
Function GetWinSys()
Set FS = CreateObject("Scripting.FileSystemObject")
GetWinSys = FS.GetSpecialFolder(1)
Set FS = Nothing
End Function

'Return Windows/temp directory
Function GetWinTemp()
Set FS = CreateObject("Scripting.FileSystemObject")
GetWinTemp = FS.GetSpecialFolder(2)
Set FS = Nothing
End Function

'Return temp filename
Function GetTempName()
Set FS = CreateObject("Scripting.FileSystemObject")
GetTempName = FS.GetTempName
Set FS = Nothing
End Function

'Return full path and temp filename
Function GetTempFullPath()
GetTempFullPath = GetWinTemp & "\" & GetTempName
Set FS = Nothing
End Function

.

والوحدة النمطية الثانية لعمل قاعدة البيانات الخارجية المؤقته ، وبها وضعنا المتغيرات ، والتي تكون متاحة لكل كائنات قاعدة البيانات ، من نماذج وتقارير ووو


Public tbldf As dao.TableDef, qrydf As dao.QueryDef, fld As Field
Public rst As dao.Recordset, rst_TQ As dao.Recordset
Public sfrm As Form
Public wrkAcc As Workspace
Public dbsNew As Database
Public mdb_Path_Name As String
Public mySQL As String

Function Make_DB(mdb_Path_Name)
On Error GoTo err_Make_DB

  
    'create an empty mdb in the same PC as the FE
    'this will allow more than one user to use This DB
    Set wrkAcc = CreateWorkspace("AccessWorkspace", "admin", "", dbUseJet)
    
    ' Make sure there isn't already a file with the name of the new database.
    If Dir(mdb_Path_Name) <> "" Then Kill mdb_Path_Name

    ' Create the new database
    Set dbsNew = wrkAcc.CreateDatabase(mdb_Path_Name, dbLangGeneral)

    dbsNew.Close
    wrkAcc.Close
    
Exit Function
err_Make_DB:

    If Err.Number = 3270 Then
        'this field does not have a caption for it, give it the field name
        
    ElseIf Err.Number = 3024 Or Err.Number = 91 Or Err.Number = 52 Or Err.Number = 53 Or Err.Number = 3055 Then
        'mdb, and Table not found to Delete
        Resume Next

    ElseIf Err.Number = 3167 Then
        'ignor, Records Deleted
        Resume Next
     
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If


End Function

.

هذا كود عمل الزر رقم 3 ، وهو كما وضعته في المشاركة السابقة ، والفرق اني وضعت ملف HTML في مجلد وندوز Temp ، وعملت الملصقات منع:


Private Sub cmd_ie_Click()
    
'
'make Reference to Microsoft Internet Controls
'c:\windows\sysytem32\ieFrame.dll
'

    Dim web As SHDocVw.InternetExplorerMedium
    Set web = New SHDocVw.InternetExplorerMedium
    Dim HTML_File As String
    
    'url header
    webBody = "<html style='width: 100%; height: 100%;'>" & vbCrLf
    webBody = webBody & "<head><style>" & vbCrLf
    '1 here we can change the Font Type, and Font size
    webBody = webBody & "table {font-family: arial, sans-serif; font-size:15px;border-collapse: collapse; width: 100%;}" & vbCrLf
    '2 here we can change cell border size, border color, Text alignment
    'with black border
    'webBody = webBody & "td, th {border: 1px solid #dddddd; text-align: center; padding: 8px;}" & vbCrLf
    'without black border
    webBody = webBody & "td, th {border: 1px solid #FFFFFF; text-align: center; padding: 8px;}" & vbCrLf
    webBody = webBody & "</style></head><body>" & vbCrLf
    webBody = webBody & "<table style='width: 100%; height: 100%;'>" & vbCrLf
    
    'How many Rows
    For i = 1 To Me.Rows
        'to create the Table Row
        webBody = webBody & "<tr>"
        
        'How many columns
        For j = 1 To Me.columns
            'make each cell
            webBody = webBody & "<th>" & Me.co1.Column(1) & "</th>"
        Next j
        
        'close the Table Row
        webBody = webBody & "</tr>" & vbCrLf
    Next i
    
    'close the HTML code
    webBody = webBody & "</table></body></html>"
    'Debug.Print webBody
    
    'save the HTML file to windows Temp folder
    HTML_File = GetWinTemp & "\524.webBody.html"
    Open HTML_File For Output As #1
        Print #1, webBody
    Close #1
    
    'make an IE
    web.Navigate HTML_File
    
    'wait until the page if fully loaded
    Do While web.ReadyState <> READYSTATE_COMPLETE
    Loop

    web.Stop

    'print preview
    web.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT

    web.Quit

    Set web = Nothing
    
End Sub

.

وهذا كود الزر رقم 4 ، والذي يفتح المجلد Temp وسيكون مختار ملف الانترنت الذي تم عمله بالزر رقم 3 :


Private Sub cmd_Temp_Folder_web_Click()

    HTML_File = GetWinTemp & "\524.webBody.html"
    
    'check if the file exists
    If Dir(HTML_File, vbNormal) = "" Then
    MsgBox "الملف غير موجود"
    Exit Sub
    End If
    
    'open windows explorer and select the temporary inter file
    Shell "explorer.exe /select," & HTML_File, vbNormalFocus
    
End Sub

.

وهذا كود الزر رقم 5 ، طريقة عمل التقرير للاستاذ رمهان بالجدول الخارجي المؤقت


Private Sub cmd_Temp_Serial_Click()
On Error GoTo err_cmd_Temp_Serial_Click
'طريقة الاستاذ رمهان

    If Len(Me.co1 & "") = 0 Then
        MsgBox "رجاء اختيار اسم الملصق"
        Exit Sub
    End If

'1
    'make a temp mdb
    mdb_Path_Name = GetWinTemp & "\temp_DB.mdb"
    Call Make_DB(mdb_Path_Name)

'2
    'Create table tbl_temp with Seq field as Integer.
    Set dbsNew = OpenDatabase(mdb_Path_Name)
    dbsNew.Execute "CREATE TABLE tbl_temp " & "(Seq INTEGER);"

'OR we can make a copy of an existing table from currentDB to the new DB
    'make a Table temp_DB using "Make Table" query in the DB temp_DB.mdb
'    mySQL = "SELECT temp_DB.* INTO tbl_temp IN " & Chr(34) & mdb_Path_Name & Chr(34)
'    mySQL = mySQL & " FROM tmp_tbl_Dates_Days"
    'Debug.Print mySQL
'    DoCmd.SetWarnings False
'        DoCmd.RunSQL mySQL
'    DoCmd.SetWarnings True

'3
    'add Records to the temp table
    Set rst = dbsNew.OpenRecordset("Select * From tbl_temp")
    'add one extra Record to meet the criteria
    For i = 1 To Me.Rows * Me.columns + 1
        rst.AddNew
            rst!Seq = i
        rst.Update
    Next i
    
    rst.Close: Set rst = Nothing
    dbsNew.Close

'4
    'make a temporary query in this DB, from tbl_temp
    mySQL = "Select * From tbl_temp IN '" & mdb_Path_Name & "'"
    
    'delete the old querydef, if exists
    CurrentDb.QueryDefs.Delete ("qrydef")
    'create a new querydef
    Set qrydef = CurrentDb.CreateQueryDef("qrydef", mySQL)
    CurrentDb.Close

'5
    'make the Report Record Source
    'mySQL is declared as Global Variable
    mySQL = "SELECT tbl1.B_Nm, qrydef.Seq FROM tbl1, qrydef"
    
'6
    'now open the Report
    'DoCmd.OpenReport "QpNew", acViewPreview, , "[B_Nm]='" & Me.co1.Column(1) & "' And Seq<=" & Me.Rows * Me.columns
    myCriteria = "B_Nm='" & Me.co1.Column(1) & "'"
    myCriteria = myCriteria & " And Seq<=" & Me.Rows * Me.columns
    DoCmd.OpenReport "QpNew", acViewPreview, , myCriteria
    
Exit Sub
err_cmd_Temp_Serial_Click:
    
    If Err.Number = 3265 Or Err.Number = 3167 Or Err.Number = 3078 Then
        Resume Next
        
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

.

وكود عمل التقرير بطريقة الاستاذ صالح ، بالجدول الخارجي المؤقت


Private Sub cmd_Temp_Records_Click()
'طريقة الاستاذ صالح حمادي

    If Len(Me.co1 & "") = 0 Then
        MsgBox "رجاء اختيار اسم الملصق"
        Exit Sub
    End If

'1
    'make a temp mdb
    mdb_Path_Name = GetWinTemp & "\temp_DB.mdb"
    Call Make_DB(mdb_Path_Name)

'2
    'Create table tbl_temp with B_Nm field as Text.
    Set dbsNew = OpenDatabase(mdb_Path_Name)
    dbsNew.Execute "CREATE TABLE tbl_temp " & "(B_Nm Text);"

'OR we can make a copy of an existing table from currentDB to the new DB
    'make a Table temp_DB using "Make Table" query in the DB temp_DB.mdb
'    mySQL = "SELECT temp_DB.* INTO tbl_temp IN " & Chr(34) & mdb_Path_Name & Chr(34)
'    mySQL = mySQL & " FROM tmp_tbl_Dates_Days"
    'Debug.Print mySQL
'    DoCmd.SetWarnings False
'        DoCmd.RunSQL mySQL
'    DoCmd.SetWarnings True

'3
    'add Records to the temp table
    Set rst = dbsNew.OpenRecordset("Select * From tbl_temp")
    
    For i = 1 To Me.Rows * Me.columns
        rst.AddNew
            rst!B_Nm = Me.co1.Column(1)
        rst.Update
    Next i
    
    rst.Close: Set rst = Nothing
    dbsNew.Close

'4
    'make the Report Record Source
    'mySQL is declared as Global Variable
    mySQL = "Select * From tbl_temp IN '" & mdb_Path_Name & "'"

'5
    'now open the Report
    DoCmd.OpenReport "QpNew", acViewPreview
    
End Sub

.

واخيرا ، كود الزر رقم 7 ، والذي يفتح المجلد Temp وسيكون مختار قاعدة البيانات الخارجية المؤقتة ، والتي تم عملها بالزرين رقم 5 و 6 ،


Private Sub cmd_Temp_Folder1_Click()

    mdb_Path_Name = GetWinTemp & "\temp_DB.mdb"
    
    'check if the file exists
    If Dir(mdb_Path_Name, vbNormal) = "" Then
    MsgBox "الملف غير موجود"
    Exit Sub
    End If
    
    'open windows explorer and select the temporary database
    Shell "explorer.exe /select," & mdb_Path_Name, vbNormalFocus
End Sub

.

جعفر

524.3.rep2.mdb.zip

**صالح حمادي** · يناير 11, 2017

ما شاء الله عليك أستاذ جعفر عمل ممتاز جدا. لا يستطيع القيام به إلا الأستاذ جعفر

شكرا جزيلا و بارك الله فيك و في عملك

**jjafferr** · يناير 12, 2017

شكرا اخي محمد على هذا الاطراء :smile:

انا قمت بهذا العمل الاضافي ليس لأخونا العود أبوخليل فحسب ، وانما لتعم الفائدة عن سهولة استخدام الجداول الخارجية ، وسأفرد موضوع خاص عن هذا الشئ ان شاء الله :smile:

جعفر

**jjafferr** · يناير 12, 2017

في 1/9/2017 at 00:48, صالح حمادي said:

أستاذي أبو خليل بالنسبة للهوامش و المسافات حلها سهل لأني وضعت متغييرن x و y من أجل التعديل في القيم و الحصول على المظهر المطلوب مع العلم أن:

كل 1 سم يساوي 576 وحدة تويب و ذلك من أجل الحصول على مسافات أكثر دقة قمت بتصميم برنامج صغير يقوم بهذه الحسابات

السلام عليكم أخي صالح :smile:

هذه المعلومة تقريبا صحيحة ، والصحيح 1 سم يساوي 567 وحدة تويب ، ولكن يجب عليك الحذر ، حيث ان 1 بوصة Inch يساوي 1440 تويب ،

مثلا:

عند عملك البرنامج ، وتريد ان تأخذ قيمة عرض الحقل (مثلا) وتتلاعب به ، فمن المهم ان تعرف ان هذه القيمة بالسنتيمتر او البوصة (لا تنسى ان لكل كمبيوتر تنصيب يختلف عن الآخر ، وبحسب الدولة التي هو فيها كذلك) :smile:

انا استعمل الوحدة النمطية التالية لأحصل على بعض معلومات الكمبيوتر ، منها وحدة القياس:

Option Compare Database

' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Public Const LOCALE_ILANGUAGE = &H1         '  language id
Public Const LOCALE_SLANGUAGE = &H2         '  localized name of language
Public Const LOCALE_SENGLANGUAGE = &H1001   '  English name of language
Public Const LOCALE_SABBREVLANGNAME = &H3   '  abbreviated language name
Public Const LOCALE_SNATIVELANGNAME = &H4   '  native name of language
Public Const LOCALE_ICOUNTRY = &H5          '  country code
Public Const LOCALE_SCOUNTRY = &H6          '  localized name of country
Public Const LOCALE_SENGCOUNTRY = &H1002    '  English name of country
Public Const LOCALE_SABBREVCTRYNAME = &H7   '  abbreviated country name
Public Const LOCALE_SNATIVECTRYNAME = &H8   '  native name of country
Public Const LOCALE_IDEFAULTLANGUAGE = &H9  '  default language id
Public Const LOCALE_IDEFAULTCOUNTRY = &HA   '  default country code
Public Const LOCALE_IDEFAULTCODEPAGE = &HB  '  default code page
Public Const LOCALE_SLIST = &HC             '  list item separator
Public Const LOCALE_IMEASURE = &HD          '  0 = metric, 1 = US
Public Const LOCALE_SDECIMAL = &HE          '  decimal separator
Public Const LOCALE_STHOUSAND = &HF         '  thousand separator
Public Const LOCALE_SGROUPING = &H10        '  digit grouping
Public Const LOCALE_IDIGITS = &H11          '  number of fractional digits
Public Const LOCALE_ILZERO = &H12           '  leading zeros for decimal
Public Const LOCALE_SNATIVEDIGITS = &H13    '  native ascii 0-9
Public Const LOCALE_SCURRENCY = &H14        '  local monetary symbol
Public Const LOCALE_SINTLSYMBOL = &H15      '  intl monetary symbol
Public Const LOCALE_SMONDECIMALSEP = &H16   '  monetary decimal separator
Public Const LOCALE_SMONTHOUSANDSEP = &H17  '  monetary thousand separator
Public Const LOCALE_SMONGROUPING = &H18     '  monetary grouping
Public Const LOCALE_ICURRDIGITS = &H19      '  # local monetary digits
Public Const LOCALE_IINTLCURRDIGITS = &H1A  '  # intl monetary digits
Public Const LOCALE_ICURRENCY = &H1B        '  positive currency mode
Public Const LOCALE_INEGCURR = &H1C         '  negative currency mode
Public Const LOCALE_SDATE = &H1D            '  date separator
Public Const LOCALE_STIME = &H1E            '  time separator
Public Const LOCALE_SSHORTDATE = &H1F       '  short date format string
Public Const LOCALE_SLONGDATE = &H20        '  long date format string
Public Const LOCALE_STIMEFORMAT = &H1003    '  time format string
Public Const LOCALE_IDATE = &H21            '  short date format ordering
Public Const LOCALE_ILDATE = &H22           '  long date format ordering
Public Const LOCALE_ITIME = &H23            '  time format specifier
Public Const LOCALE_ICENTURY = &H24         '  century format specifier
Public Const LOCALE_ITLZERO = &H25          '  leading zeros in time field
Public Const LOCALE_IDAYLZERO = &H26        '  leading zeros in day field
Public Const LOCALE_IMONLZERO = &H27        '  leading zeros in month field
Public Const LOCALE_S1159 = &H28            '  AM designator
Public Const LOCALE_S2359 = &H29            '  PM designator
Public Const LOCALE_SDAYNAME1 = &H2A        '  long name for Monday
Public Const LOCALE_SDAYNAME2 = &H2B        '  long name for Tuesday
Public Const LOCALE_SDAYNAME3 = &H2C        '  long name for Wednesday
Public Const LOCALE_SDAYNAME4 = &H2D        '  long name for Thursday
Public Const LOCALE_SDAYNAME5 = &H2E        '  long name for Friday
Public Const LOCALE_SDAYNAME6 = &H2F        '  long name for Saturday
Public Const LOCALE_SDAYNAME7 = &H30        '  long name for Sunday
Public Const LOCALE_SABBREVDAYNAME1 = &H31  '  abbreviated name for Monday
Public Const LOCALE_SABBREVDAYNAME2 = &H32  '  abbreviated name for Tuesday
Public Const LOCALE_SABBREVDAYNAME3 = &H33  '  abbreviated name for Wednesday
Public Const LOCALE_SABBREVDAYNAME4 = &H34  '  abbreviated name for Thursday
Public Const LOCALE_SABBREVDAYNAME5 = &H35  '  abbreviated name for Friday
Public Const LOCALE_SABBREVDAYNAME6 = &H36  '  abbreviated name for Saturday
Public Const LOCALE_SABBREVDAYNAME7 = &H37  '  abbreviated name for Sunday
Public Const LOCALE_SMONTHNAME1 = &H38      '  long name for January
Public Const LOCALE_SMONTHNAME2 = &H39      '  long name for February
Public Const LOCALE_SMONTHNAME3 = &H3A      '  long name for March
Public Const LOCALE_SMONTHNAME4 = &H3B      '  long name for April
Public Const LOCALE_SMONTHNAME5 = &H3C      '  long name for May
Public Const LOCALE_SMONTHNAME6 = &H3D      '  long name for June
Public Const LOCALE_SMONTHNAME7 = &H3E      '  long name for July
Public Const LOCALE_SMONTHNAME8 = &H3F      '  long name for August
Public Const LOCALE_SMONTHNAME9 = &H40      '  long name for September
Public Const LOCALE_SMONTHNAME10 = &H41     '  long name for October
Public Const LOCALE_SMONTHNAME11 = &H42     '  long name for November
Public Const LOCALE_SMONTHNAME12 = &H43     '  long name for December
Public Const LOCALE_SABBREVMONTHNAME1 = &H44 '  abbreviated name for January
Public Const LOCALE_SABBREVMONTHNAME2 = &H45 '  abbreviated name for February
Public Const LOCALE_SABBREVMONTHNAME3 = &H46 '  abbreviated name for March
Public Const LOCALE_SABBREVMONTHNAME4 = &H47 '  abbreviated name for April
Public Const LOCALE_SABBREVMONTHNAME5 = &H48 '  abbreviated name for May
Public Const LOCALE_SABBREVMONTHNAME6 = &H49 '  abbreviated name for June
Public Const LOCALE_SABBREVMONTHNAME7 = &H4A '  abbreviated name for July
Public Const LOCALE_SABBREVMONTHNAME8 = &H4B '  abbreviated name for August
Public Const LOCALE_SABBREVMONTHNAME9 = &H4C '  abbreviated name for September
Public Const LOCALE_SABBREVMONTHNAME10 = &H4D '  abbreviated name for October
Public Const LOCALE_SABBREVMONTHNAME11 = &H4E '  abbreviated name for November
Public Const LOCALE_SABBREVMONTHNAME12 = &H4F '  abbreviated name for December
Public Const LOCALE_SABBREVMONTHNAME13 = &H100F

Public Const LOCALE_SYSTEM_DEFAULT& = &H800
Public Const LOCALE_USER_DEFAULT& = &H400

Const cMAXLEN = 255

Private Declare Function apiGetLocaleInfo Lib "kernel32" _
    Alias "GetLocaleInfoA" (ByVal Locale As Long, _
    ByVal LCType As Long, ByVal lpLCData As String, _
    ByVal cchData As Long) As Long

''''
Function CountryName() As String
    Dim lngLocale As Long
    Dim strLCData As String, lngData As Long
    Dim lngX As Long
    strLCData = String$(cMAXLEN, 0)
    lngData = cMAXLEN - 1
    lngX = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCOUNTRY, strLCData, lngData)
    
    If lngX <> 0 Then
        CountryName = Left$(strLCData, lngX - 1)
    End If
End Function
''''
Function fLocaleInfo(lngLCType As Long) As String
Dim lngLocale As Long
Dim strLCData As String, lngData As Long
Dim lngX As Long

    strLCData = String$(cMAXLEN, 0)
    lngData = cMAXLEN - 1
    lngX = apiGetLocaleInfo(LOCALE_USER_DEFAULT, lngLCType, _
                    strLCData, lngData)
    If lngX <> 0 Then
        fLocaleInfo = Left$(strLCData, lngX - 1)
    End If
End Function

Function fLOCALE_IMEASURE() As String
'  0 = metric, 1 = US

Dim lngLocale As Long
Dim strLCData As String, lngData As Long
Dim lngX As Long

    strLCData = String$(cMAXLEN, 0)
    lngData = cMAXLEN - 1
    lngX = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, _
                    strLCData, lngData)
    If lngX <> 0 Then
        fLOCALE_IMEASURE = Left$(strLCData, lngX - 1)
    End If
End Function

.

وطريقة استخدامي لوحدة القياس في النموذج هكذا:

    'call the function to Get the Unit of Measurment from Windows Regional Measurment
    If fLOCALE_IMEASURE = 0 Then
        '0 = metric
        t = 567
    Else
        '1 = US
        t = 1440
    End If

.

جعفر

**صالح حمادي** · يناير 12, 2017

4 ساعات مضت, jjafferr said:

هذه المعلومة تقريبا صحيحة ، والصحيح 1 سم يساوي 567 وحدة تويب ، ولكن يجب عليك الحذر ، حيث ان 1 بوصة Inch يساوي 1440 تويب ،

شكرا جزيلا على هذا التصحيح أستاذ جعفر

تسجيل الدخول

المطلوب تكرار حقل داخل تقرير

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

jjafferr

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

شارك

ابوخليل

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

شارك

jjafferr

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

شارك

jjafferr

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

شارك

صالح حمادي

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

شارك

jjafferr

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

شارك

jjafferr

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

شارك

صالح حمادي

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

شارك

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information