نجوم المشاركات
Popular Content
Showing content with the highest reputation on 28 يول, 2024 in all areas
-
يمكنك تعديل الكود المستعمل في الملف إلى هذا وتم إضافة متغير لتحديد الصف الأخير من العمود A Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Boolean Sub Export_Range_As_Picture() Dim Ws As Worksheet, StrToFolder2 As String, lr As Long Dim oRng As Range, sPath As String, oChart As ChartObject Set Ws = ActiveSheet Application.ScreenUpdating = False StrToFolder2 = "D:\pic\" MakeSureDirectoryPathExists StrToFolder2 sPath = StrToFolder2 & Ws.Range("a1").Value & "." & "jpg" lr = Cells(Rows.Count, 1).End(xlUp).Row Set oRng = Ws.Range("A2:E" & lr) oRng.CopyPicture xlScreen, xlPicture Set oChart = Ws.ChartObjects.Add(Left:=0, Top:=0, Width:=oRng.Width * 1, Height:=oRng.Height * 1) With oChart .Activate .Chart.Paste .Chart.Export Filename:=sPath .Delete End With Application.ScreenUpdating = True End Sub بالتوفيق2 points
-
السلام عليكم ورحمة الله تعالى وبركاته ضع الصيغة التالية في الخلية (E6) مع سحبها للاسفل =IFERROR(INDEX($J$6:$J$11,MATCH(TRUE,MMULT(--(ROW($J$6:$J$11)>=TRANSPOSE(ROW($J$6:$J$11))),$I$6:$I$11)>=ROWS($1:1),0)),"") في حالة الرغبة بتسلسل عمود المدة بقدر بيانات عمود المبلغ في الخلية (F6) مع سحب المعادلة للاسفل =IF(E6<>"",ROWS($A$1:A1),"") Book1.xlsx2 points
-
2 points
-
اشكرك جدا استاذ محمد هشام على مجهودك وربنا يجعله في ميزان حسناتك اشكرك جدا استاذ محمد وربنا يجعله في ميزان حسناتك1 point
-
الحمد لله رب العالمين ... بارك الله فيك اخي الكريم منكم نتعلم استاذي الفاضل @Foksh اشكر لك الاطراء1 point
-
نعم اخي لاكن ما الغرض من تسلسل رقم السيارة على ورقة التقرير يمكنك نسخ البيانات دون الاعتماد على وجود رقم السيارة مسبقا في حالتك هده يمكنك الاعتماد على عدد الصفوف لكل جدول والتي سوف تجبرك على توحيد عدد الصفوف على جميع الجداول مادا لم تمت اظافة رقم السيارة بعدد يتجاوز عدد الصفوف المقترحة مسبقا وهي على ملفك 60 صف ؟ على العموم تم تعديل الكود على حسب تصميمك للملف ربما يناسبك Option Explicit Sub Filter_ListUniques() Dim WS As Worksheet: Dim src As Worksheet Set WS = Worksheets("1"): Set src = Worksheets("التقرير") Dim Lastrow&, f&, n& Dim list As Object, item As Variant, Rng As Range, tmp As Range Set list = CreateObject("System.Collections.ArrayList") Application.ScreenUpdating = False Intersect(src.Range(src.Rows(2), src.UsedRange.Rows(src.UsedRange.Rows.Count)), _ Union(src.Range("A:G"), src.Range("I:J"))).ClearContents Set tmp = WS.Range("A1:J1") With WS If .AutoFilterMode Then .AutoFilterMode = False For Each item In .Range("H2", .Range("H" & .Rows.Count).End(xlUp)) If Not list.Contains(item.Value) Then list.Add item.Value Next End With For Each item In list With tmp .AutoFilter 8, item '<<======Car number column Lastrow = WS.Cells(WS.Rows.Count, "H").End(xlUp).Row WS.Range("a2:j" & Lastrow).SpecialCells(xlCellTypeVisible).Copy If WorksheetFunction.CountA(src.Range("a:a")) = 1 Then n = src.Cells(src.Rows.Count, "a").End(xlUp).Row + 1 Else 'The number of rows between tables n = n + 61 End If src.Range("a" & n).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False 'Copy column headings src.Range("a" & n - 1 & ":j" & n - 1).Value = tmp.Value .AutoFilter End With Next Application.ScreenUpdating = True End Sub تقرير V2.xlsb1 point
-
ملحوظة انا اضفت كود الى قائمة السياق لاغلاق ايا كان تقرير او نموذج وذلك لاضفاء المرونة التامة لاستخدام نفس قائمة السياق ان اردنا مع اى نموذج او تقرير دون كتابة العديد من الاكواد امممممم طبعا نصيحتى الذهبية انا قدمت اليك الكود مستخدما الاحرف العربية داخل المحرر وهذا ما لا احبذه انصحك وان اردت استخدام اللغة العربية تحويلها من خلال التطبيق التالى وبذلك تكون الاكواد بالطربقة المثلى داخل الموديول بالشكل التالى Option Compare Database Option Explicit ' Constants for button states and control types Public Const BUTTON_STATE_DOWN As Integer = -1 ' BUTTON_STATE_DOWN: Represents the state where a button is pressed down or activated. ' Used to indicate that a button is in the pressed state. Public Const BUTTON_STATE_UP As Integer = 0 ' BUTTON_STATE_UP: Represents the state where a button is in its normal (not pressed) state. ' Used to indicate that a button is not pressed or activated. Public Const CONTROL_TYPE_BUTTON As Integer = 1 ' CONTROL_TYPE_BUTTON: Represents a button control type in a command bar or menu. ' Used to add buttons to a command bar or menu. Public Const CONTROL_TYPE_EDIT As Integer = 2 ' CONTROL_TYPE_EDIT: Represents an edit control type, such as a text box. ' Typically used to add an editable text field to a command bar or menu. Public Const CONTROL_TYPE_COMBOBOX As Integer = 4 ' CONTROL_TYPE_COMBOBOX: Represents a combo box control type in a command bar or menu. ' A combo box allows users to select from a list of options or enter a custom value. Public Const CONTROL_TYPE_POPUP As Integer = 5 ' CONTROL_TYPE_POPUP: Represents a popup menu or sub-menu control type. ' Used to create a dropdown menu or context menu in a command bar. Public Const BAR_TYPE_POPUP As Integer = 5 ' BAR_TYPE_POPUP: Represents a popup menu bar type. ' Used to create a new command bar that behaves as a popup menu (i.e., appears on right-click or when invoked). ' Variables for CommandBar and Controls Public commandBar As Object ' Represents the custom command bar (popup menu) Public commandButton As Object ' Represents each button/control added to the command bar Public commandBarName As String ' Name of the custom command bar ' Subroutine to create and configure the custom command bar Public Sub CreateCustomCommandBar() ' Ignore errors during creation or deletion of the command bar On Error Resume Next ' Define the name of the custom command bar commandBarName = "cmb_CustomMenu" ' Name of the custom command bar ' Delete the existing command bar with the same name, if any CommandBars(commandBarName).Delete If Err.Number <> 0 Then Err.Clear ' Add a new command bar (popup menu) with the specified name Set commandBar = CommandBars.Add(commandBarName, BAR_TYPE_POPUP, False, False) With commandBar ' Add Cut button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 21, , , False) ' Button caption >>--> Cut commandButton.Caption = ChrW(1602) & ChrW(1589) commandButton.FaceId = 21 ' Icon for the Cut button ' Add Copy button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 19, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly ' Button caption >>--> Copy commandButton.Caption = ChrW(1606) & ChrW(1587) & ChrW(1582) commandButton.FaceId = 19 ' Icon for the Copy button ' Add Paste button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 22, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly ' Button caption >>--> Paste commandButton.Caption = ChrW(1604) & ChrW(1589) & ChrW(1602) commandButton.FaceId = 22 ' Icon for the Paste button ' Add Sort Ascending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 210, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons ' Button caption >>--> Sort Ascending commandButton.Caption = ChrW(1578) & ChrW(1585) & ChrW(1578) & ChrW(1610) & ChrW(1576) & ChrW(32) & ChrW(1578) & ChrW(1589) & ChrW(1575) & ChrW(1593) & ChrW(1583) & ChrW(1610) commandButton.FaceId = 210 ' Icon for the Sort Ascending button ' Add Sort Descending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 211, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons ' Button caption >>--> Sort Descending commandButton.Caption = ChrW(1578) & ChrW(1585) & ChrW(1578) & ChrW(1610) & ChrW(1576) & ChrW(32) & ChrW(1578) & ChrW(1606) & ChrW(1575) & ChrW(1586) & ChrW(1604) & ChrW(1610) commandButton.FaceId = 211 ' Icon for the Sort Descending button ' Add Close Form/Report button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 923, , , False) ' Updated to False commandButton.BeginGroup = True ' Start a new group ' Button caption >>--> Close commandButton.Caption = ChrW(1573) & ChrW(1594) & ChrW(1604) & ChrW(1575) & ChrW(1602) commandButton.OnAction = "CloseCurrentItem" ' Call the CloseCurrentItem subroutine End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing End Sub ' Subroutine to close the currently active form or report Public Sub CloseCurrentItem() ' Ignore errors if no form or report is open ' On Error Resume Next Dim obj As Object ' Close the active form if it exists For Each obj In Forms If obj.Name = Screen.ActiveForm.Name Then DoCmd.Close acForm, obj.Name Exit Sub End If Next obj ' Close the active report if it exists For Each obj In Reports If obj.Name = Screen.ActiveReport.Name Then DoCmd.Close acReport, obj.Name Exit Sub End If Next obj ' If no form or report is active, show a message MsgBox "There is no active form or report to close.", vbExclamation ' Clean up Err.Clear End Sub Converter Arabic and Unicode (v. 3).accdb1 point
-
تفضل اخي Option Explicit Sub filtre() Dim f$, Lastrow&, Cnt&, n&: f = "من المدرسة" Dim WS As Worksheet: Set WS = Sheets("الصف الثانى ") Dim src As Worksheet: Set src = Sheets("محولين الى المدرسة") Application.ScreenUpdating = False src.Range("B10:U" & src.Rows.Count).ClearContents Lastrow = WS.Range("V" & WS.Rows.Count).End(xlUp).Row For Cnt = 10 To Lastrow If UCase(WS.Range("V" & Cnt).Value) Like f Then n = n + 1 src.Range("B" & n + 9 & ":U" & _ n + 9).Value = WS.Range("B" & Cnt & ":U" & Cnt).Value End If Next Application.ScreenUpdating = True End Sub لتنفيد الكود تلقائيا عند التغيير في عمود التحويلات المدرسية (الصف الثانى ) Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("V10:V600")) Is Nothing Then Application.EnableEvents = False Application.Run ("filtre") Application.EnableEvents = True End If End Sub سجل مستجدين - 2025 V2.xlsm1 point
-
اتفضل يا استاذ يوسف Option Compare Database Option Explicit ' Constants for button states and control types Public Const BUTTON_STATE_DOWN As Integer = -1 ' BUTTON_STATE_DOWN: Represents the state where a button is pressed down or activated. ' Used to indicate that a button is in the pressed state. Public Const BUTTON_STATE_UP As Integer = 0 ' BUTTON_STATE_UP: Represents the state where a button is in its normal (not pressed) state. ' Used to indicate that a button is not pressed or activated. Public Const CONTROL_TYPE_BUTTON As Integer = 1 ' CONTROL_TYPE_BUTTON: Represents a button control type in a command bar or menu. ' Used to add buttons to a command bar or menu. Public Const CONTROL_TYPE_EDIT As Integer = 2 ' CONTROL_TYPE_EDIT: Represents an edit control type, such as a text box. ' Typically used to add an editable text field to a command bar or menu. Public Const CONTROL_TYPE_COMBOBOX As Integer = 4 ' CONTROL_TYPE_COMBOBOX: Represents a combo box control type in a command bar or menu. ' A combo box allows users to select from a list of options or enter a custom value. Public Const CONTROL_TYPE_POPUP As Integer = 5 ' CONTROL_TYPE_POPUP: Represents a popup menu or sub-menu control type. ' Used to create a dropdown menu or context menu in a command bar. Public Const BAR_TYPE_POPUP As Integer = 5 ' BAR_TYPE_POPUP: Represents a popup menu bar type. ' Used to create a new command bar that behaves as a popup menu (i.e., appears on right-click or when invoked). ' Variables for CommandBar and Controls Public commandBar As Object ' Represents the custom command bar (popup menu) Public commandButton As Object ' Represents each button/control added to the command bar Public commandBarName As String ' Name of the custom command bar ' Subroutine to create and configure the custom command bar Public Sub CreateCustomCommandBar() ' Ignore errors during creation or deletion of the command bar On Error Resume Next ' Define the name of the custom command bar commandBarName = "cmb_CustomMenu" ' Name of the custom command bar ' Delete the existing command bar with the same name, if any CommandBars(commandBarName).Delete If Err.Number <> 0 Then Err.Clear ' Add a new command bar (popup menu) with the specified name Set commandBar = CommandBars.Add(commandBarName, BAR_TYPE_POPUP, False, False) With commandBar ' Add Cut button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 21, , , False) commandButton.Caption = "قص" ' Button caption commandButton.FaceId = 21 ' Icon for the Cut button ' Add Copy button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 19, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly commandButton.Caption = "نسخ" ' Button caption commandButton.FaceId = 19 ' Icon for the Copy button ' Add Paste button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 22, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly commandButton.Caption = "لصق" ' Button caption commandButton.FaceId = 22 ' Icon for the Paste button ' Add Sort Ascending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 210, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons commandButton.Caption = "ترتيب تصاعدي" ' Button caption commandButton.FaceId = 210 ' Icon for the Sort Ascending button ' Add Sort Descending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 211, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons commandButton.Caption = "ترتيب تنازلي" ' Button caption commandButton.FaceId = 211 ' Icon for the Sort Descending button ' Add Close Form/Report button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 923, , , False) ' Updated to False commandButton.BeginGroup = True ' Start a new group commandButton.Caption = "إغلاق" ' Button caption commandButton.OnAction = "CloseCurrentItem" ' Call the CloseCurrentItem subroutine End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing End Sub ' Subroutine to close the currently active form or report Public Sub CloseCurrentItem() ' Ignore errors if no form or report is open ' On Error Resume Next Dim obj As Object ' Close the active form if it exists For Each obj In Forms If obj.Name = Screen.ActiveForm.Name Then DoCmd.Close acForm, obj.Name Exit Sub End If Next obj ' Close the active report if it exists For Each obj In Reports If obj.Name = Screen.ActiveReport.Name Then DoCmd.Close acReport, obj.Name Exit Sub End If Next obj ' If no form or report is active, show a message MsgBox "There is no active form or report to close.", vbExclamation ' Clean up Err.Clear End Sub بخصوص الفاصل غير القيمة البولينية من false الى true فقط فى السطر الذى تريده لعمل الفاصل بين الاوامر فى قائمة السياق commandButton.BeginGroup = False ' Group items under this button من محرر الاوامر للمرة الاولى اعمل Run للدالة : CreateCustomCommandBar وفى النموذج خلى ShortcutMenuBar = cmb_CustomMenu1 point
-
1 point
-
أخي الكريم muhandes ramadan قمت بعمل معظم المطلوب حسب استطاعتي وهو كالتالي: نموذج فعال جدا في البحث والطباعة طولية وعرضية تقرير حسب المعايير التالية عند اختيار القضاء, الناحية, القرية/المحلة التقرير كل البيانات كما في جدول المشاريع عرضي و ورق A3 والاستعانة بخبراء المنتدي سيحسن من أداء القاعدة يتبع الجدول العام لإدارة المشاريع.rar1 point
-
أخي الكريم صاحب الاستفسار ما يظهر في شريط المعادلات هو قيمة الخلية الأصلية ويمكنك التحكم في طريقة عرضها من خلال تنسيق الخلايا format cells أما إذا كنت تريد أن يظهر في شريط المعادلات القيم بعد التقريب باستخدام معادلة مثلا =TRUNC(A1,0) فيجب نسخ بيانات النطاق بعد التقريب ثم لصقه كقيم paste as values مكان النطاق الأصلي بالتوفيق للجميع1 point
-
Hello Nabil Try this code Sub Move_PDF_Files() Dim ws As Worksheet, sDesktop As String, srcFolder As String, desFolder As String, empName As String, sFile As String, TargetFolder As String, lr As Long, r As Long Set ws = ThisWorkbook.Sheets("Sheet1") sDesktop = Environ("UserProfile") & "\Desktop\" srcFolder = sDesktop & "SourceFolder\" desFolder = sDesktop & "DestinationFolder\" If Dir(desFolder, vbDirectory) = "" Then MkDir desFolder lr = ws.Cells(Rows.Count, "E").End(xlUp).Row For r = 2 To lr empName = ws.Cells(r, "E").Value sFile = empName & ".pdf" TargetFolder = desFolder & empName & "\" If Dir(TargetFolder, vbDirectory) = "" Then MkDir TargetFolder If Dir(srcFolder & sFile) <> "" Then FileCopy srcFolder & sFile, TargetFolder & sFile Else Debug.Print "File [" & sFile & "] Not Found In Source Folder" End If Next r MsgBox "PDF Files Moved Successfully!", 64 End Sub This is for illustration1 point
-
Try this instead Function MyRound(ByVal mainVal As Double, ByVal roundVal As Double) As Double Dim h As Double, v As Double On Error GoTo ErrSub h = roundVal / 2 If mainVal >= 0 Then If (mainVal Mod roundVal) >= h Then v = Application.WorksheetFunction.RoundUp(mainVal / roundVal, 0) * roundVal Else v = Application.WorksheetFunction.RoundDown(mainVal / roundVal, 0) * roundVal End If End If MyRound = v Exit Function ErrSub: MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight MyRound = 0 End Function1 point
-
وعليكم السلام ورحمة الله تعالى وبركاته طلبك غير واضح !!!!! أظن أنه سبق التطرق إلى هذا الموضوع مسبقا بفكره مشابهة نوعا ما يرجى مراجعة الرابط التالي ربما يفيدك1 point
-
1 point
-
هلا والله بالجمال والدلال سلمت يداك على هذه التحفة ،🤗، المثالين جميلين ، والثاني فكرته أجمل 😍1 point
-
1 point
-
على افتراض ان الكومبوبوكس اسمه Foksh :- Private Sub btnPrintReport_Click() If IsNull(Me.Foksh) Or Me.Foksh = "" Then MsgBox "يرجى اختيار قيمة من القائمة قبل طباعة التقرير.", vbExclamation, "تحذير" Else DoCmd.OpenReport "أكتب هنا اسم التقرير", acViewPreview End If End Sub هذا تصور اخي الكريم ، على افتراض أيضاً أن اسم ايقونة الطباعة btnPrintReport1 point
-
وعليكم السلام ورحمة الله تعالى وبركاته كما سبق الذكر من طرف الأستاذ @طارق محمود أنسب طريقة لتنفيد طلبك على ما أعتقد هي إستخدام الأكواد خاصة إذا كانت لك رغبة بالإشتغال على الملفات وهي مغلقة مع وضع عدة معايير للتحقق يمكنك تجربة هدا الاقتراح ربما يناسبك يكفي وضع مصنف المطابقة في نفس مسار الملفات سيتم تحديث البيانات تلقائيا Sub CopyData() '''''''''( رصيد عملاء Workbook ) Dim FileName$, Path$, wbSource$, rng As Range, FilePath$, sPath$ Dim src As Worksheet: Set src = Sheets("1") Path = ThisWorkbook.Path wbSource = "رصيد عملاء.xlsx": FileName = src.[A1] If FileName = "" Then: Exit Sub ' التححق من وجود المصنف FilePath = Path & "\" & wbSource If Len(Dir(FilePath)) = 0 Then MsgBox "الملف غير موجود", vbExclamation, wbSource: Exit Sub End If ' التححق من وجود ورقة العمل sPath = ActiveWorkbook.Path & "\" If Not Verification(sPath, wbSource, FileName) Then MsgBox wbSource & " " & " الورقة " & " : " & FileName & " غير موجودة على مصنف", vbInformation: Exit Sub End If With Application .ScreenUpdating = False .DisplayAlerts = False src.Range("B3:P" & src.Rows.Count).ClearContents a = "B3:B300": b = "C3:C300": c = "D3:P300" '<<===== ' Paste data(المطابقة) Cnt = "Q12:Q300": Cnt2 = "S12:S300": Cnt3 = "CB12:CN300" '<<===== 'Data range(رصيد عملاء) 'كود المنتج src.Range(a).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt 'المنتج src.Range(b).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt2 ' من يناير الى الإجمالى src.Range(c).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt3 ling = src.UsedRange.Rows.Count: Set rng = src.Range("B3:P" & ling) With rng .Value = .Value: .Borders.LineStyle = xlNone .Replace "#N/A", "", xlWhole: .Replace "0", "", xlWhole End With ' Underline the rows Sheets("1") For Each c In rng.Rows If WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous Next .ScreenUpdating = False .DisplayAlerts = False End With End Sub Sub CopyData2() '''''''''''''( عملاء Workbook ) Dim FileName$, Path$, wbSource$, rng As Range, FilePath$, sPath$ Dim src As Worksheet: Set src = Sheets("1") Path = ThisWorkbook.Path wbSource = "عملاء.xlsx": FileName = src.[R1] If FileName = "" Then: Exit Sub FilePath = Path & "\" & wbSource If Len(Dir(FilePath)) = 0 Then MsgBox "الملف غير موجود", vbExclamation, wbSource: Exit Sub End If sPath = ActiveWorkbook.Path & "\" If Not Verification(sPath, wbSource, FileName) Then MsgBox wbSource & " " & " الورقة " & " : " & FileName & " غير موجودة على مصنف", vbInformation: Exit Sub End If With Application .ScreenUpdating = False .DisplayAlerts = False src.Range("S3:AG" & src.Rows.Count).ClearContents a = "S3:S300": b = "T3:T300": c = "U3:AG300" '<<===== ' Paste data(المطابقة) Cnt = "Y4:Y300": Cnt2 = "Z4:Z300": Cnt3 = "FK4:FW300" '<<===== 'Data range(عملاء) 'كود المنتج src.Range(a).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt 'المنتج src.Range(b).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt2 ' من يناير الى الإجمالى src.Range(c).FormulaArray = "='" & Path & "\[" & wbSource & "]" & FileName & "'!" & Cnt3 ling = src.UsedRange.Rows.Count: Set rng = src.Range("S3:AG" & ling) With rng .Value = .Value: .Borders.LineStyle = xlNone .Replace "#N/A", "", xlWhole: .Replace "0", "", xlWhole End With ' Underline the rows Sheets("1") For Each c In rng.Rows If WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous Next .ScreenUpdating = False .DisplayAlerts = False End With End Sub Function Verification(fPath As String, fName As String, sheetName As String) Dim f As String f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1" Verification = Not IsError(Application.ExecuteExcel4Macro(f)) End Function Sheets("1") وفي حدث Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Select Case Target.Address(0, 0) Case "A1": Call CopyData: Case "R1": Call CopyData2 Target.Select Case Else: Exit Sub End Select End Sub Workbook event Private Sub Workbook_Open() Call CopyData: Call CopyData2 End Sub إستدعاء بيانات.zip1 point
-
سأكشف لكم عن سر 👀 كنت قد بدأت منذ عدة أيام بإنشاء طريقة تساعد على عمل قوائم مختصرة للنماذج ، ولكنها أخذت مني وقتاً وجهداً كبيرين ، وتوقفت عند مرحلة إعادة تجميع الأفكار 😇 💡 قريباً النسخة الأولى 💡1 point
-
تم عملها برمجيا كاي قائمة مختصرة لكن في القاعدة التي ارفقتها تم استيرادها بدون اوامر البرمجة الخاصة بها يمكن اضافة وتعديل القائمة حسب الرغبة كالتالي: Sub CustomizeShortcutMenu() Dim cb As CommandBar Dim ctl As CommandBarControl ' الوصول إلى القائمة المختصرة الموجودة Set cb = Application.CommandBars("cop") ' إضافة عنصر جديد إلى القائمة المختصرة Set ctl = cb.Controls.Add(Type:=msoControlButton, Temporary:=True) With ctl .Caption = "New Menu Item" .OnAction = "MyCustomFunction" End With End Sub ' دالة مخصصة Sub MyCustomFunction() MsgBox "This is a custom function!" End Sub1 point
-
أ/ محمد هشام تحية طيبة مرسل مثال المقصود او المطلوب من زيادة عدد الصفوف في شيت التقرير هو ترحيل كل ما يخص السيارة من شيت رقم 1 الي شيت التقرير بمعني كل ما اضيف بيانات في شيت رقم 1 تخص اي رقم سيارة من السيارات ترحل الي الصفوف الخاصة بها في شيت التقرير علما بان شيت رقم 1 لا يقتصر علي البيانات المرسلة فقط ولكن سيضاف بيانات اكثر او صفوف اكثر في شيت 1 والمراد ترحيلها لشيت التقرير ويضاف ايضا اكثر من سيارة وشكرا تقرير.xlsx1 point
-
السلام عليكم أخي الكريم إضافة للكود الذي أكرمنا به أخينا المتميز محمد هشام إليك حل بالمعادلات والنطاق الديناميكي تفضل تقرير.xlsx1 point
-
1 point
-
أستاذنا ومعلمنا @ابوخليل نظل وسنظل نتعلم ونغتنم منكم الخبرة في الترتيب واستخدام الأكواد المناسبة حين الحاجة فقط و.......................................................... سلمت يداك .1 point
-
1 point
-
شكراً جزيلاً اخي الكريم على تواصلك تم تحويل الدالة من حدث عند النقر إلى حدث بعد التحديث صحيح هذا خطأ من عندي وتم عمل زر للحفظ ،لكن اخي الكريم لو سمحت ليس المقصود جعل تاريخ الجلسة يصيير مكان تاريخ الاجتماع في نموذج الاجتماعات ولكن المقصود ان تاريخ الجلسة يتعدل في جدول الاجتماعات وجدول النشاطات كذلك تاريخ الاجتماعات يتعدل في جدول النشاطات عند تعديله في نموذج الاجتماعات المشكلة انه فقط يتم تعديل حقل واحد الي هو اسم الجلسة او اسم الاجتماع وعند تعديل الحقلين الاسم والتاريخ معا في جدول الجلسات وجدول الاجتماعات لا يتم تعديلهم في الجداول المرتبطة معهم ---مطلوب هو اخي الكريم تعديل وليس استبدال او خلي نقول استبدال بالي تم تغييره وانا الممنون meeting.rar0 points