الرائد77

TextBox1.Value = Format(TextBox1.Value, "HH:mm:ss")

لا توجد صورة.أاعد ارفاقها

تفضل جرب هدا تواتي29).xlsm

تفضل تواتي 28.xlsm

تفضل . لك ما طلبت الكوود في حدث ورقة العمل. التاريخ في الخلية d1 للا يتغيير الا في 01 جوييلية من كل سنة و يببقى ثابت في الخللية الى 01/07 القادم يمكنك تغيير تتاريخ االجهاز و التجريب. daate ffin.xlsm

بعد ادن اخي بن علية العدد الاكثر تكررارا مع اضافة عدد مرات التكرار و اضافة تنسيق شرطيي لتلوين الرقم الاكثر تكرارا ايجاد الرقم الاكثر تكراراً.xlsx

جرب هذا 7 معادلات مختلفة .. أختتر ما يناسبك DAATES.xls

تفضل. نموذج المطلوب.xlsm

أخي سليم . المعادلة لا تدرج المكرر . النتيجة بالصورة

بعد اذن حبيبي سليم معادلة صفيف. أكتب فقط السنة في الخلية g1 =IFERROR(INDEX($A$2:$A$170; MATCH(0;COUNTIF($G$3:G3; IF(($G$1=YEAR($B$2:$B$170)); $A$2:$A$170; $G$3)); 0)); "") إدراج الاسماء تلقائي.xlsx

تفضل اضافة زر لحدف الصورة من الشيت في الملف المرفق و ادا اردت من زر التصدير الى الشيت أن يحذف الصورة و يرسل الجديدة مكانها بدون زر حذف على الفورم غير كود التصدير الى هذا Private Sub CommandButton10_Click() Dim Image As Variant Dim L As Single, T As Single, W As Single, H As Single ActiveSheet.Pictures.Delete L = Range("n32:r38").Left T = Range("n32:r38").Top W = Range("n32:r38").Width H = Range("n32:r38").Height Image = TextBox1.Value If Image <> False Then Sheet4.Shapes.AddPicture Image, True, True, L, T, W, H End If End Sub تواتي 23.xlsm

تفضل كود استيراد الصور Private Sub CommandButton9_Click() Dim IMPATH As String Dim IMNAME As String With Application.FileDialog(msoFileDialogOpen) .InitialFileName = ThisWorkbook.Path .Filters.Clear .Filters.Add JPEG, "*.JPG, .JPEG" .Title = "ادراج صورة" .ButtonName = "ادراج الصورة مع تحيات االرائد" .AllowMultiSelect = False If .Show = True Then Me.TextBox1.Visible = True IMPATH = .SelectedItems(1) Me.TextBox1.Text = IMPATH Me.Image1.Picture = LoadPicture(IMPATH) Else MsgBox "تم تحميل الصورة" End If End With End Sub كود نقل الصورة الى الشيت Private Sub CommandButton10_Click() Dim Image As Variant Dim L As Single, T As Single, W As Single, H As Single L = Range("n32:r38").Left T = Range("n32:r38").Top W = Range("n32:r38").Width H = Range("n32:r38").Height Image = TextBox1.Value If Image <> False Then Sheet4.Shapes.AddPicture Image, True, True, L, T, W, H End If End Sub تواتي 23.xlsm

تفضل شهادة.xlsm

بعد اذن حبيبي سليم للاثراء =SMALL($B$2:$B$14;COUNTIF($B$2:$B$14;"<"&E2)+1) تجريبي 2.xlsx

انت تستتعمل windows xp حاول تثبيت هدا الملف https://download.microsoft.com/download/1/f/4/1f477e1b-4534-48ff-b31e-eb6f29b8a85f/VBA64-KB822150-X86-FRA.exe و جرب الملف المرفق cheque.xlsm

تم تجريب ملف الأخ ببن علية حاجي في مشاركته الأولى على اووفيس 2016 و 2019 و الملف يعمل جيدا 100/100. ربما المشكل عندك أاخي وادي سلي. حاول اررسال صورة للخطأ و ان شاء الله سنجد لك الحل

تفضل تواتي 20.xlsm

تم التعديل. استبدل الكود السابق بهذا Sub pdfcopy2() Application.Calculation = xlCalculationAutomatic Application.DisplayStatusBar = False Application.EnableEvents = False Dim wsA As Worksheet Dim wbA As Workbook Dim strName As String Dim strPath As String Dim strFile As String Dim strPathFile As String Dim myFile As Variant Dim lOver As Long On Error GoTo errHandler Set wbA = ActiveWorkbook Set wsA = ActiveSheet strPath = ThisWorkbook.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" For i = 2 To 4 If i <> "" Then strName = i & "-" & Sheets(i).Name & "-" & Sheets(i).Range("b3").Value strFile = strName & ".pdf" strPathFile = strPath & strFile If bFileExists(strPathFile) Then lOver = MsgBox("ÇáãáÝ ãæÌæÏ ãÓÈÞÇ.åá ÊÑíÏ ÇÓÊÈÏÇáå¿", _ vbQuestion + vbYesNo, "ãáÝ ãæÌæÏ") If lOver <> vbYes Then myFile = Application.GetSaveAsFilename _ (InitialFileName:=strPathFile, _ FileFilter:="PDF Files (*.pdf), *.pdf", _ Title:="ÅÎÊíÇÑ ãÌáÏ ÇáÍÝÙ") If myFile <> "False" Then strPathFile = myFile Else GoTo exitHandler End If End If End If Sheets(i).ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=strPathFile, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End If Next i MsgBox "Êã ÅäÔÇÁ ÇáãáÝ ÈÅÓã ÇáãÚäí: " & vbCrLf & strPathFile errHandler: Resume exitHandler exitHandler: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True End Sub 17 (1).xlsm

ادا اردت كل التوارييخ حتى المكرررة . ضع هذه المعادلة =COUNTIFS($D$4:$D$13;">"&$G$4;$D$4:$D$13;"<"&$I$4)

تفضل معادلة صففيف بدون حساب التواريخ المكررة تواتي 19.xlsx

غير في هذا السطر For i = 1 To Sheets.Count حييث 1 يمثل الورقة 1 مثلا For i = 2 To 5 اي من الورقة 2 الى الورقة 5 غير حسب ما تريد

أخي التواتي . كان يجب التوضيح من الاول بأن هناك معادلات مع طلبك .ليتم اجابتك بسرعة .لعدم ضياع الوقت تفضل حبيبي الملف النهائي الازاحة الى الاعلى و ازاحة الخلايا التي تحنوي على المعادلات معها تواتي 15) fini.xlsm

تفضل انتبه اخي قلت من a1 وو في الجدول الفعلي في ورقتك a9 لذلك هذا الكود يقوم بالاززاحة الى الاعلى ابتداءا من الخلية a1 و لا يحذف الصف كاملا اذا اردتت البدء من a9 غير في الكود Private Sub CommandButton2_Click() On Error Resume Next With Range("a1:d32") .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub تواتي 15.xlsm

تفضل Private Sub CommandButton2_Click() On Error Resume Next With Range("b9:b10000") .SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub تواتي 15.xlsm

تفضل Private Sub CommandButton2_Click() ActiveSheet.PrintOut From:=Range("B8"), To:=Range("C8"), Copies:=1, Collate:=True End Sub تواتي 12.xlsm