نجوم المشاركات

السلام عليكم ورحمة الله وبركاته.. الكثير يجهل امكانية الأكسس في جعل البرامج بشكل responsive أي انه: لو كانت لديك شاشة كبيرة سيتغير شكل برنامجك وتوزيع الأزرار والعناصر لتتناسب مع حجم الشاشة ولو كانت الشاشة صغيرة ايضا ستتغير اماكن العناصر لكي تتناسب مع طبيعة الشاشة وعدم فقدان أي عنصر او ضياعه عندك تغيير الشاشات. قبل البدء، سأقدم لكم مثال على ما اقصده: هذا اخر مشاريعي في الأكسس وهو يتغير تبعاً لأختلاف الشاشات. لنبدأ: سأقوم بوضع Button في منتصف الشاشة بحيث لا يتغير مكانه لو تغير حجم الشاشة ثم قم بعملية الأدراج من جميع الأماكن ( يسار, يمين, أعلى , أسفل ) بحيث يصبح كالأتي: ثم من الطرف اليمين، نختار الأرتساء الأفقي ( كلاهما ) وكذلك الحال بالنسبة لليسار كذلك الحال نطبق على الأعلى والأسفل لكن هذه المرة سوف نعدل الأرتساء العمودي وكذلك بالنسبة للأعلى جرب الآن وسوف ترى ان الـ Button سيبقى في الوسط مهما تغير حجم الشاشة لو وضعت شاشة كبيرة أو صغيرة سيظل بنفس مكانه في الوسط. أي سؤال أنا موجود، تحياتي لكم.

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

السلام عليكم، وانا اتصفح النت وجدت مقال باللغة الانكليزية يتحدث عن ارشادات ونصائح لتسريع آلية عمل البرنامج وايضا للتحسين من جودة الكود المصدر: https://www.shamrock-software.eu/vb.htm للمهتم بقراءة المقال: Faster Visual Basic Programs Simple tricks for VB optimization Microsoft Visual Basic is a popular programming language. While many applications at Shamrock were written in C and C++, some were also created in VB. Especially its string concept and string functions make life easier than in other languages and also improve stability: Crashes caused by buffer overflows and null pointer problems, well-known to most C programmers, are quite rare in VB. A few simple tricks make execution speed even faster. They were tested with VB4, VB5 and VB6. Please note that the given CPU times should be read as relative values which greatly depend on the PC speed. Use the dollar symbol for string functions One might expect that Mid$( ) and Mid( ) are the same and the dollar symbol representing the string type is more or less implicit for string manipulating functions. But without the $, VB will return a variant value and has to reconvert it to a string later. Adding the $ is an optimization. It will explicitly enforce a string value to be returned. Running a loop 10 million times on a test PC shows significant timing differences: e$ = mid("ABC", 2) 5.0 s e$ = mid$("ABC", 2) 1.9 s So a dollar symbol should be added behind all functions returning a string to avoid the unnecessary type conversion: Chr ChrB CurDir Dir Format Hex Input InputB LCase Left LeftB Mid MidB Oct Right RightB RTrim Space Str String Trim UCase There are also speed differences between Asc and AscW, and Chr$ and ChrW$. Because the functions with a W (for wide) do not have to convert the VB-internal 16-bit Unicode characters to 8-bit ANSI codes or vice versa, they are a bit faster. While the difference between Chr and ChrW is marginal, AscW is nearly two times as fast as Asc. But take care: AscW may return values above 255, depending on the character set used, and this is not always easy to handle. Assigning and testing empty strings A loop assigning an empty string to a string variable 10 million times gives surprising results, too. While absolute times may again differ on your system, the improvement when using vbNullString is significant: e$ = "" 1.51 s e$ = vbNullString 0.38 s Note that the predefined constant vbNullString is not exactly the same as an empty string, but it can be used as an equivalent and even returns true when comparing vbNullString = "" (while vbNullString is a null pointer, "" results in a pointer to a string with zero length; however, not all API/DLL functions handle them identically, so be careful). Checking if a string is empty 10 million times can also be done in different ways. Here are the times for doing it 10 million times on our test system: If "ABC" = "" 0.73 s If "ABC" = vbNullString 0.58 s If Len("ABC") = 0 0.46 s If LenB("ABC") = 0 0.39 s So the speed nearly doubles if you are using LenB instead of comparing the string with an empty string. Note that you should not replace Len by LenB in general, since LenB returns the byte count in the VB double-byte strings instead of the character count. But for simply checking if the length is zero, LenB is the fastest method. Checking character codes To check if the first character of a string matches a specified code, AscW is more than two times faster than using a conventional string comparison: If "A" = "A" 1.17 s if Asc("A") = 65 1.01 s If AscW("A") = 65 0.52 s Visual Basic always uses Unicode strings internally, so AscW does not need to convert 16-bit Unicode values to 8-bit ANSI values like Asc. Note, however, that AscW (and also Asc) will cause a runtime error if the given string is empty, so take care. Furthermore, AscW returns Unicode values instead of ANSI codes, but this does not make a difference for ASCII codes from 0 to 127. For national symbols, the result depends on the system's default character code. String to number conversion When you convert a string to a numeric variable, the most common function is Val( ). But if the numeric variable is an integer or a long integer, why waste time for floating-point calculations? Converting the string to the desired variable is much faster. The following example shows the required time for converting a string "1234567" to a long integer 10 million times: i& = Val(e$) 24.2 s i& = CLng(e$) 6.5 s However, unfortunately, the behaviour of CLng (32 bit) and CInt (16 bit) is a bit different compared to Val: If the parameter is an empty string, a runtime error occurs, while Val would simply return zero. If the string is hex or octal and contains a dot or a comma (e.g. "&H1.2"), a runtime error occurs. Commas and dots are interpreted depending on national settings, e.g. "1.234" will give 1234 on an Austrian or German PC, since dots are used for grouping thousands, while a comma is used for decimals. What's better, Visual Basic or C? Good question, just like "what's better, apples or oranges". If a program must never crash due to unexpected string lengths or similar causes, VB is a good choice, but do not forget to handle all possible runtime errors properly. If speed is more important, assembler is best, immediately followed by C. So Val might still be the better choice if either the speed is not critical or if it cannot be guaranteed that the string is not strictly numerical. Be careful, though - even Val is not absolutely robust: Things like Val("1@e") will generate a run-time error. So do not use either it if you do not really expect a numerical string! Multiple conditions in one line In contrary to many other languages, Visual Basic (just as the QuickBasic compiler and the GwBasic interpreter in the old DOS days) executes all conditions in an IF statement, whether this makes sense or not. For instance, C, Javascript or Perl never call the Function check(2 ) in this sample if check(1) returns 0=false: if (check(1) && check(2)) But Visual Basic always checks both, which is not really optimal since it wastes time. Here is a workaround. Instead of using if check(1) and check(2) ... execution will be much faster if you write: if check(1) then if check(2) ... Of course this is not really critical for comparing simple variables, but calling functions unnecessarily increases the CPU time. It is also useful to think about which of the conditions will be more often false than the other one(s) and put it at the beginning -- but this is a good idea for all programming languages, of course. Similarly, in most programming languages a second condition after a logical OR ("||" in C, Javascript or Perl) is not executed if the first condition is already true. Visual Basic is different again. A demonstration example: If True Or MsgBox("Test") then j=1 This will show a message box, even though the execution of MsgBox is totally obsolete. It will save execution time if you change the program flow so that no OR-combined statements occur. True is non-zero Nearly all programs contain tests for non-zero or greater-than-zero values, like: If Instr(x$, ",") > 0 Then ... Note that Instr never returns negative values, so <>0 is just as good as >0. Knowing this, the line can be abbreviated to: If Instr(x$, ",") Then ... since a condition is always treated as True if the result is non-zero. However, be careful when using Not: If Not Instr(x$, ",") Then ... This would not work since Not negates all bits and thus only works correctly with -1 (True, all bits set) and 0 (False, all bits reset) as Boolean values! Instead, If Instr(x$, ",") = 0 Then ... must be used. Imagine you are writing a function which returns true if string a is greater than string b. A beginner would write: Private Function Comp(a$, b$) as Boolean If a$ > b$ Then Comp = True Else Comp = False End Function Now, first of all, "Else Comp = False" is obsolete since all variables and the return value is initialized to 0, False, or empty when a function is entered. But even more tricky, the following function is equivalent to the above and faster: Private Function Comp(a$, b$) as Boolean Comp = a$ > b$ End Function Declaring Long as the default variable type The module-level code of each form and module should always contain at least these two statements at the very beginning: Option Explicit DefLng A-Z Option Explicit makes sure that you will have to declare all variables explicitly which significantly enhances code quality. DefLng A-Z defines all variables with no explicit type declaration as 32-bit long integers (called dwords in C) which is the native data type in all modern CPUs. If you forget this, your variables will be variants, resulting in a much slower program execution and more memory consumption. It is also not recommended to use 16-bit integers instead - though they are shorter, execution will be slower than with native 32-bit types. In general, avoid the Variant data type which is much slower than any other. Copying small things to large strings If you have to add some small strings to a long string many times, this can get extremely slow. The reason is that Visual Basic makes a copy of the large destination string each time when something is added to it. A sample which takes about 12 seconds on a test PC: For i = 0 to 10000 a$ = a$ & "This " & "is a test" Next Something like a$ = a$ & b$ gets extremely slow when a$ gets large. A small "cache" string can speed up things significantly. The following version runs in less than 0.1 s -- more than 100 times faster though the result is still 140014 characters long! For i = 0 to 10000 c$ = c$ & "This " & "is a test" If Len(c$) > 3000 then a$ = a$ & c$: c$ = vbNullString Next If LenB(c$) Then a$ = a$ & c$ 'Add rest if any The trick is that c$ is used for chunks of data which can be copied relatively fast. Only when the chunk in c$ gets big enough it is then added to the result in a$. Making VB 4+5 applications work in Windows 7 and Vista When you try to launch a Visual Basic 4.0 or 5.0 program in Windows 7 or Vista for the very first time and UAC (user access control) is enabled, which is the default, it displays a message "Error accessing the system registry" and will not work. The cause is that the VB runtime DLL attempts to write values in a registry path which is not accessible for users and normal applications. There are two ways to circumvent this, and later program starts will then work without any problem: Right-click the Visual Basic program und select "Run as administrator" when launching it for the first time. - Or: Rename the program to Setup.exe or Install.exe. In this case you will be prompted if you agree to start it. An alternative is to call the application from another program named Setup.exe using the Windows API function ShellExecute( ) or the Shell command in VB. If the program needs to register an OCX module, this will require one of the above methods even if another Visual Basic program was running before: Normal users or programs are not allowed to register such modules. Also keep in mind that only Setup programs are allowed to copy OCX files into the System32 folder. The problems described above do not exist with VB 6 because Microsoft has included an adapted version of the VB 6 runtime library in Windows 7 and Vista which is installed automatically to avoid compatibility problems. This also fixes problems with data execution prevention (DEP) supported by newer CPUs, though this option is disabled by default for applications. Programs written in VB 4+5 are incompatible with CPU-supported DEP and will crash immediately (or not even start) if it is enabled. More tricks Forms and controls Set the ClipControls property in forms, frames and picture boxes to false if you do not use graphic methods. Set the AutoRedraw property in forms to false if you do not really need it (see VB help for details). If you need to access a property of an object more than once (e.g. Text1.Text), cache it in a variable. While setting many properties in a control, e.g. a list box, hide it until you are ready to avoid repainting. Avoid references to another form, they would load the hidden form into memory even when it is not needed. Before compiling, move all forms to a default position (top left) where they are visible on smaller screens, too. Functions, variables, constants Remove functions and sub procedures which are never called in your program; they would be compiled, too. Use predefined VB string constants like vbBack, vbCr, vbLf, vbCrLf, vbNullChar, vbTab instead of Chr$( ). Use your own constants for values and strings if they occur more than once in the program. Replace local Static variables in functions and procedures by module-level global variables, they are faster. Do not use strings for saving binary data if the program might be used in countries like Japan with multi-byte characters. ASCII values like 130 would be encoded into multiple bytes. Use byte arrays instead. Other recommendations When using Elseif or Case, check the most quickly evaluable or the most frequent conditions first. StrComp(a$,b$,1) is faster than testing LCase$(a$)=LCase$(b$). Both handle national characters correctly. Try to avoid the DateDiff function in loops, it is slow. For comparing two dates, simply use =, <, >. Use Get instead of Input$( ) to read data from a binary file, it is much faster. When using On Error Goto, do not forget to close all local file handles before exiting the sub or function. On Chinese/Japanese/Korean (CJK) computers, ANSI codes >127 in text files are interpreted as double-byte characters. Don't use LSet or the Windows function RtlMoveMemory to copy one user-defined type into another with a different structure even if they seem to have the same length; LenB will show you that VB uses fill bytes between the elements. © 1/2010 Shamrock Software GmbH

السلام عليكم 🙂 هذه آخر محاولة لي ، وقد قمت بتغيير العمل: Option Compare Database Option Explicit Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer 'unify endline characters, so that we can use Split function myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, Chr(10) & Chr(13), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) ' myValue = Replace(myValue, " ", " ") ' myValue = Replace(myValue, " ", " ") ' myValue = Replace(myValue, " ", " ") 'convert the one paragraph into different phrases separated by vbcrlf x = Split(myValue, vbCrLf) 'Loop through the phrases For j = 0 To UBound(x) 'remove the extra spaces on the Left x(j) = Trim(x(j)) If Len(x(j)) > 1 And j <> UBound(x) Then 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it 'only if the right character is a spcae and its not the last phrase x(j) = Trim(Mid(x(j), 1, Len(x(j)) - 1)) & vbCrLf End If 'Remove the Empty lines (one character length), and accumelate the rest of the lines If Len(x(j)) < 2 Then Else Remove_Extras = Remove_Extras & x(j) End If Next j 'this is an Access conversion error, so lets uninfy it like all endlines Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'replace the VT characters with vbcrlf 'if the last character is vbcrlf, remove it, so that we dont have extra empty line at the end If Right(Remove_Extras, 1) = vbCrLf Or Right(Remove_Extras, 1) = Chr(10) Or Right(Remove_Extras, 1) = Chr(13) Then Remove_Extras = Mid(Remove_Extras, 1, Len(Remove_Extras) - 2) End If End Function جعفر أسطر3.zip

جرب هذه المعادلة (Crtl+Shift+Enter) وليس Enter وجدها =VLOOKUP(SUM(IFERROR(IF(ISNUMBER(FIND({"Can limon";"Rosie"},A3)),ROW($A$1:$A$12),""),"")),{0,0;1,100;2,70},2,0) File included vlk_Find.xlsx

السلام عليكم 🙂 عندنا تقرير بهذه الطريقة : . ونريد نعملة بهذه الطريقة : . نعمل التقرير ، ثم نعمل مجاميع لأي من الحقول ، ثم نعمل حقل ليحسب عدد السجلات للمجموعة : . ويجب عمل برواز الحقول شفاف : ---------------------------------------------------------------------- التعديل - 1 ، 27/11/2020 تصحيح البرنامج ، على فرضية اطوال السجلات مختلفة وتحتوي على اكثر من سطر ثم نرسل هذه البيانات للوحدة النمطية Box_Lines التي تقوم بعمل البرواز : نرسل اسم الحقل المطلوب عمل المربع الكبير حوله ، ولون الخط ، ولون البرواز ، وعدد سجلات المجموعة : Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer) 'No way to adjust the field Height, so we Draw a Box around the new Height Call apply_Max_Height("rpt", 0, "save", RGB(221, 217, 195)) 'Expand the field to be the size of the combined Records 'Call Box_Lines(fld , Text Fore color, Border Color, Group_Record_Count) 'Call Box_Lines(Me.Name, "save", vbBlack , vbBlack , Me.save_Footer) Call Box_Lines(Me.Name, "save", RGB(16, 37, 63), RGB(221, 217, 195), Me.save_Footer) End Sub . واستخدمت الوحدة النمطية لأخونا العود ابو خليل من هنا ، لضبط اطوال جميع السجلات الى الاطول : طلب كود تنسيق نمو حقول التقرير - قسم الأكسيس Access - أوفيسنا (officena.net) وتقوم الوحدة النمطية Box_Lines بعمل المطلوب ، بعمل حقل واحد (للجقل المطلوب) : Option Compare Database Option Explicit Dim str_Text As String Dim int_Counter As Integer Public fildMaxHeight As Integer Dim ctl As Control ' Public Function Box_Lines(rpt_Name As String, fld_Name As String, rgb_Fore As Long, rgb_Border As Long, Group_Record_Count As Integer) Dim L As Single Dim T As Single Dim W As Single Dim H As Single Set ctl = Reports(rpt_Name)(fld_Name) 'make it simple to understand L = ctl.Left W = ctl.Width T = ctl.Top H = ctl.Height 'take the highst Height If fildMaxHeight > H Then H = fildMaxHeight End If 'this is to know when a new Group starts If ctl <> str_Text Then str_Text = ctl int_Counter = 1 End If ctl.BorderColor = vbWhite ctl.ForeColor = vbWhite Reports(rpt_Name).Line (L, T)-(L, W), rgb_Border 'Left Line Reports(rpt_Name).Line (W, T)-(W, H), rgb_Border 'Right Line 'COULDN'T GET IT TO WORK ' If int_Counter = Group_Record_Count Then 'Last Record ' Reports(rpt_Name).Line (L, H)-(W, H), rgb_Border 'Bottom Line ' End If If int_Counter = 1 Then 'First Record ctl.ForeColor = rgb_Fore 'Text ForeColor Reports(rpt_Name).Line (L, T)-(W, T), rgb_Border 'Top Line End If int_Counter = int_Counter + 1 End Function Public Function find_Max_Height(rpt_Name As String, Section_Number As Integer) fildMaxHeight = 0 For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Height > fildMaxHeight Then fildMaxHeight = ctl.Height End If Next End Function Public Function apply_Max_Height(rpt_Name As String, Section_Number As Integer, Exclude_fld_Name As String, rgb_Border As Long) fildMaxHeight = 0 'get the max Height For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Height > fildMaxHeight Then fildMaxHeight = ctl.Height End If Next 'Draw lines around the fields For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Name <> Exclude_fld_Name Then Reports(rpt_Name).Line (ctl.Left, ctl.Top)-Step(ctl.Width, fildMaxHeight), vbWhite, BF Reports(rpt_Name).Line (ctl.Left, ctl.Top)-Step(ctl.Width, fildMaxHeight), rgb_Border, B End If Next End Function . -------------------------------------------------------------------- النسخة اعلاه فيها خطأ ، فرجاء استعمال النسخة الاحدث ، والتي نستطيع فيها العمل على اكثر من حقل : جعفر 1293.1.Report_Draw_BoxLine.mdb.zip

الحمدلله 🙂 والمفروض يكون اسرع من الكود السابق 🙂 ورجاء تجربته في الموضوع الآخر كذلك ، وضع الجواب هناك 🙂 حعفر

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

يجري الان تصميم النظام في بيئة غير الاكسس لما لها من مشاكل واجهت العملاء النسخة الجديدة تدعم قواعد بيانات SQL وبيئة .NET وفور اصدارها سأضع رابط التحميل هنا ان شاء الله

هذه طريقة ايقاف هذه الحماية الطريقة الأولي ايقاف اعدادات الماكرو كما بصور

عبقري

عليك استخدام هذه المعادلة طبقاً لطلبك =IF(A3="","",IF($A3="Can limon",0%,IF($A3="Rosie",100%,70%))) New Microsoft Excel Worksheet1.xlsx

سلسلة تعليم بور كويري الجزء العاشر كيفية تقسيم الخلية إلى عدة صفوف في البور كويري Split Into Rows IN POWER QUERY في الفيديو دة تقدر تفصل الخلية اللي فيها اكتر من بيان إلى صفوف وتطلع منها تقارير زي ما انت عايز

أسطر3.rar

ايوه هذا المطلوب ... شكرا جزيلا لك أ خالد على مساعدتك لي ...

هل هذه هي الصورة المطلوبة

جرب هذا الكود : Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer Dim mySpace As String For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) 'remove the extra spaces on: x(j) = LTrim(x(j)) 'remove the left spaces If Len(x(j)) < 2 Then Else 'remove the extra spaces on: x(j) = LTrim(x(j)) 'remove the left spaces 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it 'only if the right character is a spcae mySpace = Mid(x(j), 1, Len(x(j)) - 1) If Right(mySpace, 1) = " " Then x(j) = Trim(mySpace) & vbCrLf End If Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function جعفر

بالنسبة للمسافات الزائدة ((( وليس الأسطر (لم ابحث من قبل)) ) وطريقة البحث عنها وضبطها فميكروسوفت اوجدت طريقة محكمة في جميع تطبيقاتها : اكسس او اكسل او وورد بواسطة البحث والاستبدال في وورد معروف مكانها ضمن قائمة التحرير ، وفي اكسس يتم ذلك على الجدول مباشرة : النقر بزر الفأرة الأيمن على العمود واختيار بحث من التبويب استبدال: في حقل استبدال : ننقر مسافتين وفي حقل استبدال بــ : ننقر مسافة ونوافق على العملية

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

اما تجربتي فتقول ، قبل: . وبعد: . جرب المرفق 🙂 جعفر أسطر2.zip

الأخ الكريم جعفر .. الكود لم يعد يأكل الكلام 🙂 .. لكنه لا يحذف السطر الفارغ إذا كان السطر الذي بعده في أوله مسافة .. يحذف أولا المسافة في أول السطر ثم بعد تشغيله مرة ثانية يحذف السطر الفارغ بينما الكود الأول الذي تفضلت به Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) 'remove the extra spaces on: x(j) = LTrim(x(j)) 'the Left x(j) = RTrim(x(j)) 'the Right If Len(x(j)) < 2 Then Else Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function كان يحذف الأسطر الفارغة بغض النظر عن المسافات في اوائل الأسطر وشكرا للأخ (هاوي) على مشاركته .. لكن لم أعرف كيف أستدعي الكود .. ولما جربته بشكل منفصل وكتبت أسم الجدول والحقل لم يحذف إلا المسافات التي في آخر الحقل فقط، أما إلمسافات التي في أواخر الأسطر الأخرى فبقيت كما هي

وتعديل آخر: Function Remove_Extras(myValue As String) As String Dim x() As String Dim j As Integer Dim mySpace As String For j = 1 To 999 'remove all the extra characters at the end of the line If Right(myValue, 1) = Chr(7) Or _ Right(myValue, 1) = vbCr Or _ Right(myValue, 1) = vbLf Or _ Right(myValue, 1) = vbCrLf Then myValue = Mid(myValue, 1, Len(myValue) - 1) Else Exit For End If Next j 'now remove the empty lines myValue = Replace(myValue, Chr(7), vbCrLf) myValue = Replace(myValue, vbCr, vbCrLf) myValue = Replace(myValue, vbLf, vbCrLf) x = Split(myValue, vbCrLf) For j = 0 To UBound(x) If Len(x(j)) < 2 Then Else 'remove the extra spaces on: x(j) = LTrim(x(j)) 'remove the left spaces 'separate the text from vbcrlf, Remove the extra spaces, then attache vbcrlf to it 'only if the right character is a spcae mySpace = Mid(x(j), 1, Len(x(j)) - 1) If Right(mySpace, 1) = " " Then x(j) = Trim(mySpace) & vbCrLf End If Remove_Extras = Remove_Extras & x(j) End If Next j Remove_Extras = Replace(Remove_Extras, Chr(11), vbCrLf) 'remove all VT characters End Function . ولكن المطلوب ليس تحويل المسافات الى مسافة واحدة ، وانما المطلوب حذف هذه المسافات/المسافة 🙂 قاعدة البيانات المرفقة فيها مثال ، فجرب كودك عليها 🙂 جعفر

والله يا استاذة انا فهمي على قدي جربي لعله المطلوب النتيجة في استعلام 5 4.accdb

تفضل كما تريد .... بالتنسيق الشرطى حمادة.xls

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

انا مطمئن لما اتعامل مع عمالقة مثلك ومثل اخونا الكبير ابو الكرم ، وكل اللي تقولوه على راسي 🙂 بس كنت خايف من الحرفين الباقين ، ترى الدكتور حسنين مو سهل ، يسحبنا شوي شوي 😁 جعفر

الحمد لله اننا لازلنا محافظين على قوانين المنتدى ، بقية بس شعرة واحدة وننزلق الى المحظور 😁 جعفر

حسب فهمي لكلامك استاذة سحر استكمال بيانات الترقيات3.accdb

أهلا بك.. أنت بحاجة إلى التحقق من كون الملف موجود قبل إجراء عملية النسخ بهذه الطريقة... Sub CopyFile() Dim rs As DAO.Recordset Dim fso, sSourceFile, sDestinationFile Set fso = CreateObject("Scripting.FileSystemObject") Set rs = CurrentDb.OpenRecordset("SELECT crn FROM BASIC_DATE") If rs.RecordCount = 0 Then Exit Sub End If rs.MoveFirst Do Until rs.EOF sSourceFile = Application.CurrentProject.Path & "\CONTACT\" & rs!crn & ".pdf" sDestinationFile = Application.CurrentProject.Path & "\CONTACT\old\" '-- تحقق من أن الملف موجود قبل إجراء عملية النسخ If fso.FileExists(sSourceFile) Then fso.CopyFile sSourceFile, sDestinationFile, True fso.DeleteFile sSourceFile End If rs.MoveNext Loop End Sub

السلام عليكم ورحمة الله تم تعديل الكود ارجو ان يكون هو المطلوب Sub FinalResult() Const Res = "ناجح ومنقول إلى الصف السابع بتقدير" Dim ws As Worksheet Dim LR As Long, I As Long, x As Integer Dim Mad As String t = Timer Application.ScreenUpdating = False Set ws = Sheets("ك.د.سد") On Error Resume Next ws.Range("F" & I + 3).ClearContents LR = ws.Range("C" & Rows.Count).End(3).Row I = 11 Do While I <= LR If ws.Cells(I, 33) = "ناجح" Then ws.Cells(I + 3, 6).Value = Res & "" & ws.Cells(I, 29).Value ElseIf ws.Cells(I, 33) = "له دور ثان في" Then x = 38 Do While x <= 50 Mad = Mad & "-" & ws.Cells(I, x).Value ws.Cells(I + 3, 6).Value = ws.Cells(I, 33).Value & " " & Mad x = x + 2 Loop End If Mad = "" I = I + 4 Loop Application.ScreenUpdating = True 'MsgBox Round(Timer - t, 2) End Sub

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

طيب وبالنسبة للدرجة الاولى لعلي محمد لانه الدرجات سبع وعلى محمد حصل على الثانية والرابعة والخامسة المفقودة الاولى والثالثة والسادسة والسابعة ممكن اخفاء الدرجة الاولى اذا كان لها اشتراطات او غير مطلوبة ممكن عملها باكثر من طريقة ولكن من اسهل الطرق نستخرجها عن طريق استعلام غير المتطابقات و النتيجة في استعلام q_3 استكمال بيانات الترقيات2.accdb

رابط اخر

بسم الله الرحمن الرحيم لاعداد تنصيب لملف الاكسيل كاى برنامج تقوم بتنصيبه على جهازك يحتاج الامر الى خطوتين الخطوه الاولى : تحويل ملف الاكسيل الى ملف تنفيذى ,و يعتبر هذا التحويل من افضل الطرق لحمايه اكواد الملف من كسر الحمايه حيث يصعب جدا كسر حمايه كلمه السر و قد قمت باستخدام برنامج XLtoEXE (البرنامج بالمرفقات) كما هو واضح بالصور الان قمت بتحويل ملق الاكسيل الى ملف تنفيذى . الخطوه الثانيه: اعداد تنصيب ببرنامج InnoSetup (البرنامج بالمرفقات) لهذا الملف و الظهور مع Start او سطح المكتب و اضافه ملفات اخرى قد يحتاجها الملف و يمكن استخدام هذا البرنامج مع اى ملف بامتداد exe لتنصيبه مرفق ملف بعد فك الضغط ستجد ثلاثه ملفات الاول : XLtoEXE و هو البرنامج الذى يقوم بالتحويل من أكسيل الى exe الثانى : InnoSetup و هو البرنامج الذى يقوم بالتنصيب الثالث : setup ملف تطبيق للشرح السابق السلام عليكم Excel.rar

اليك هذا Private Sub writing_KeyDown(KeyCode As Integer, Shift As Integer) Select Case True Case ((Shift = acCtrlMask) And (KeyCode = vbKeyZ)) KeyCode = 0 End Select End Sub

فى البداية نقوم بفتح برنامج الاردوينو ومسح المحتوي الذى بداخلة كله ولصق هذا الكود : // Example_1_Computer MSACCESS_Interfacing // Design By : Karim Adel El-Hosseny // Mobile : 01277877151 int Door=7; // تهيئه متغير يقوم يتعويض رقم المنفذ 7 الى اسم لسهولة البرمجة int value; // تهيئة متغير لتخزين قيمة القراءه من المنفذ التسلسلي void setup () // دالة عامه لتهيئة المنفذ التسلسلي { Serial.begin(9600); // ضبط معدل النقل ويجب ان تتوافق هذه القيمة مع القيمة المضبوطبه بالبرنامج بالاكسس pinMode(Door,OUTPUT); // تهيئة الطرف الخاص بالخرج digitalWrite(Door,LOW); // جعل قيمة الجهد المسلط على الطرف الخاص بالخرج مساوى لصفر فولت } void loop () { // دالة تكرار لا نهائية value = Serial.read(); // تخزين قيمة البيانات المستلمة من المنفذ التسلسلي والمرسلة من الاكسس بالمتغير المحجوز مسبقاً if (value == '1') // يقوم هذا الامر من مراجعة قيمة البيانات المرسلة اذا كانت مساوية للواحد ويتحقق الشرط يقوم بتنفيذ الاوامر التالية { digitalWrite(Door,HIGH); // جعل الالجهد المسلط على الطرف مساوية لاعلى فولت ممكن delay(3000); // الانتظار لمده ثلاث ثواني digitalWrite(Door,LOW); // جعل الجهد المسلط على الطرف مساوية لاقل فولت ممكن } else if (value == '0') {digitalWrite(Door,LOW);} // وفى حالة عدم تحقق الشرط يجعل الجهد المسلط على الطرف لاقل فولت ممكن } ولفهم الكود بشكل اكبر سنقو بشرحة خطوه خطوه فى البداية تعريف للكود والمصمم له : // Example_1_Computer MSACCESS_Interfacing // Design By : Karim Adel El-Hosseny // Mobile : 01277877151 -------------------------------------------------------------------------------------------------------------------------------- int Door=7; int value; وفى هذا الجزء قمنا بحجز سجل ( متغير رقمي ) فى الذاكره المؤقته بالميكروكونترول باسم Door و جعلنا قيمتها 7 و 7 هى رقم الطرف الذى سيوصل عليه البوابة او لمبة الاناره ويكون الرقم مكتوب بجوار الطرف كما بالصورة : وحجز خانة اخري بالمسمي Value لتسجيل بها البيانات المستقبله من طريق السيريال بورد . void setup (){ } وهى دالة محجوزة بالميكروكونترول ويكتب بها اوامر النهيئة الخاصة بالاطراف او الموديلات الداخلية المدمجة معه . Serial.begin(9600); ويقوم هذا الامر بتفعيل وتهئية موديل السيريال بورد المدمج مع الميكروكونترول ويخبره بان معدل نقل البيانات المستخدم هو 9600 كيلو بايت ويجب ان يكون جهاز الكمبيوتر متوافق مع هذا الرقم وايضا البيانات المرسلة من الاكسس كما سنوضحها لاحقاً . pinMode(Door,OUTPUT); طبيعة الطرف ان الاردوينو لكل طرف بها وظيفتين اساسيتان والبعض اكثر من وظيفة فالوظيفه الاولى هى استعمالة كخرج بمعني ان يقوم بتوصيل كهرباء لهذا الطرف او قطع الكهرباء عنه وهذا مفهوم بسيط لتسهيل استيعابه والوظيفة الشانية ان يستخدم كدخل اى ان يقوم بفحصه هل يوجد عليه كهرباء ام لا . اذا فالوظيفة الاولى كخرج والثانية كدخل . ونحن هنا نستخدمة كخرج فنامره عند ارسال قيمة معينه من الاكسس يقوم بالتوصيل واذا انقطعت يتوقف . digitalWrite(Door,LOW); وكما وضحنا فى الامر السابق اننا نستخدمه كخرج فيتحكم هذا الامر فى طبيعة الخرج وقمنا بامره ان يجعل الكهرباء المسطله اقل قيمة كهربيه اى صفر فولت لا لا يقوم بالتوصيل او التشغيل . void loop () { } وهى دالة البرنامج الرئيسى التى اول ما يعمل الميكرو ويقوم بالتهيئة يدخل اليها لتنفيذ التعليمات المرغوبة . ملحوظة هامه : ان الميكروكونترول ليس مرن كالاكسس بمعنى انه يقوم بتنفيذ التعليمات بالترتيب ولا يستطيع ان يقفز الى امر اخر دون المرور على البقية . value = Serial.read(); وهنا نامر الميكرو بتسجيل البيانات المستقبلة فى المتغير المحجوز سلفاً فى الكود . if (value == '1') { وكالمعتاد والمتوقع عن ايجاد دالة الشرط IF كما تعودنا استخدامها فى الاكسس وتختلف فقط بطريقة كتابها كما موضح . وتقوم بفحص حالة المتغير فاذا كانت قميته تساوى واحد صحيح يقوم بتنفيذ الاوامر واذا لم تكن يقوم بتنفيذ التالى وكذلك يمكن استخدام Elseif ونرسل قيمة مثلا 2 فيقوم بفتح بوابة اخري وهكذا . digitalWrite(Door,HIGH); فاذا تحقق الشرط يقوم بجعل قيمة الخرج المسلط على الطرف المحدد سلفاً باعلى قيمة فولت لتشغيل الريلاى لفتح البوابة . delay(3000); وهذه داله تمنيت وجودها فى الاكسس وهى دالة تأخير زمني والرقم 3000 بمعني 3 ثواني فالميكروكونترول لديه قدره لتقسيم الثانية الواحده الى 1000 جزء ويتعامل معها كجزء من الـ1000 digitalWrite(Door,LOW); بعد الانتظار لمدة ثلالث ثواني يقوم بتخفيض الفولت الى صفر لغلق البوابة واذا احببتم زياده الوقت نقوم بزياده ال 3000 else if (value == '0') {digitalWrite(Door,LOW);} وفى حالة عدم تحقق الشرط او عدم وجود قيمة يقوم بابقاء الفولت منخفض للحفاظ على غلق البوابة . وبعد الانتهاء من ادخل الكود نقوم بالضغط على علامه الصح بالاعلى للتأكد من صحه الكود وفى حالة الخطأ سيقوم البرنامج بالتوضيح فى الجزء الذى بالاسف بالاخطاء الموجوده ويجب ان تظهر هذه العبارات التى توضح المساحة المستخدمة من الذاكره الخاصة بالميكرو والرام فاذا ظهرت هذه الرسالة يكون الكود خالى من الاخطا وبامكانك شحن الاردوينو بالبرنامج من هذه العلامة : وهكذا نكون اتممنا برمجه الاردوينو بنجاح . والله الموفق . ونلتقي قريباً .

دالة if البسيطة و المركبة

قد اخبرتك انظر مصدر سجلات التقرير والذي هو الاستعلام وانظر الى المعيار للوصول اليه : خصائص التقرير/لسان التبويب بيانات / مصدر السجلات/ انقرعلى الايقونة الصغيرة التي الى اليسار والمرسومة بثلاث نقاط سيظهر لك الاستعلام

الأخ طارق إليك الملف التالي هل يفي بالغرض أخوك أبو البراء Baraa.rar