الـعيدروس

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

السلام عليكم جرب المرفق خاصية البحث_ALI.rar

السلام عليكم بعد اذن استاذنا الحبيب عبدالله المجرب جرب المرفق ترحيل_ali.rar

السلام عليكم الاستاذ الحبيب نادر حفظك الله ملفات جميلة من عملها ومن تنسيقها كا جمال روحك حقيقة موضوع افاد الكثيرين اكرر ردي لإعجابي بهذا العمل بارك الله فيك تقبل مروري

السلام عليكم تابع هذا الموضوع للاستاذ القدير محمد يحياوي مشاركة رقم 10# http://www.officena.net/ib/index.php?showtopic=39748

السلام عليكم اليك الشرح في المرفقات استخدام ارفاق ملف فلاش في الاكسل في حالتين الحالة الاولى تستخدمها اذا كان حجم الملف كبير ولاتريد زيادة حجمه واما الحالة الثانية تستخدمها اذا كان حجم الملف صغير ولا مشكلة في زيادة حجمه alidroos.rar

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

السلام عليكم جرب هكذا إن شاء الله يزبط معاك Public Sub ALI_F() Dim F_ALI, R_ALI As Range, T As Integer F_ALI = Array("2011", "/", "01", "11", "12", "_") For T = 0 To 3 For Each R_ALI In Range("D7", Range("D" & Rows.Count).End(xlUp)) If InStr(R_ALI, F_ALI(T)) <> 0 Then GoTo 1 Exit Sub Else If R_ALI.Value <> "" Then R_ALI.Value = [E2].Value & " _ " & R_ALI.Value End If 1 Next R_ALI Next T End Sub

وعليكم السلام الحمد لله انه زبط معاك ولاشكر على واجب وفقك الله

السلام عليكم الاستاذ الحبيب معتصم محمد هذه كانت احد المحاولات للحصول على حل هو كان الكود كما تفضلت بهذا الشكل Sub MACRO15() Dim thedate As String, thetime As String, greeting As String, fullname As String, firstname As String, ali As String Dim spaceinname As Integer, abood As String, alidroos As String, MY As String, thkr As String, thedat As String VBA.Calendar = vbCalGreg thedat = Format(Date, "long date") VBA.Calendar = vbCalHijri thedate = Format(Date + 1, "long date") thetime = Format(Time, "medium time") abood = "التـاريخ هجري" ali = "التاريخ ميلادي" alidroos = "السـاعه" thkr = "لاتنسـى ذكــر الله" MY = "لا اله الا الله محمد رسول الله maicl2010ye@gmail.com" Select Case Time Case Is < TimeValue("12:00"): greeting = "السـلام عليكم صبــاح الخير" Case Is >= TimeValue("12:00"): greeting = "السـلام عليكم مســاء الخير" Case Else: greeting = "تصبح على خير" End Select fullname = Application.UserName spaceinname = InStr(1, fullname, "", 1) If spaceinname = 0 Then spaceinname = Len(fullname) firstname = Left(fullname, spaceinname) greeting = greeting MsgBox abood & thedate & vbNewLine & "=====================" _ & vbNewLine & vbCrLf & ali & thedat & vbNewLine & _ "=====================" & vbNewLine & vbCrLf & alidroos & thetime _ & vbNewLine & "=====================" & vbNewLine & vbCrLf & thkr _ & vbNewLine & "=====================" & vbNewLine & vbCrLf & MY _ & vbNewLine & "====================================" & vbNewLine, vbInformation, greeting End Sub وعند الأخ عبدالقادر لايعمل بهذا الشكل ولا عند استخدام متغير Variant

السلام عليكم بارك الله فيك استاذ يحياوي كود جميل استاذ محمد صالح تشكر على هذا الشرح المفيد وفقكم الله نستثمر هذا الكود لعملية بسيطه وهو طلب لاحد الأعضاء على انه اذا فتح الملف في الكمبيوتر أول مرة يظهر رسالة وأما اذا فتح مسبقاً لاتظهر الرسالة بيكون الكود هكذا Private Sub Workbook_Open() Dim Counter As Long, LastOpen As String, Msg As String Counter = GetSetting("yah", "med", "العدد", 0) LastOpen = GetSetting("yah", "med", "الفتح", "") Counter = Counter + 1 LastOpen = Date & " " & Time SaveSetting "yah", "med", "العدد", Counter SaveSetting "yah", "med", "الفتح", LastOpen If Val(Counter) = 0 Then MsgBox "أهلا وسهلا", vbInformation, "منتدى أوفسينا" Else Exit Sub End If End Sub

السلام عليكم استاذي الحبيب محمد صالح العذر منك والسموحه كنا نكتب المشاركة لم نرى مشاركتكم الطيبه بارك الله فيك وزادك من علمة وفضلة

تفضل امسح الكود الذي في المودويل واستعيضه بهذا Public appTime As Date Public Sub Blink() With Sheets(1).Range("A1").Interior If .ColorIndex = 2 Then .ColorIndex = 3 Else .ColorIndex = 2 End If End With appTime = Now() + TimeValue("00:00:01") Application.OnTime appTime, "Blink" End Sub Public Sub ALI() Application.OnTime appTime, "Blink", , False End Sub وهذا الكود حطه في حدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value <= 0 Then Call Blink Else Call ALI Exit Sub End If End Sub وهذا المرفق كود يجعل خلية تومض _ali.rar

السلام عليكم اخي الفاضل لاداعي لإرفاق الملف بهذا الحجم كنت ترفق مثال بسيط وعليه عشرة اسطر فقط لتوضيح الطلب كي يسهل العمل عليه من قبل الأساتذه وبرضه الرقم السري يتغلى ويرفق بارك الله فيك استخدم هذا الكود ليلغي كل الباسورد الذي في الأوراق Public Sub U() Dim SH As Worksheet For Each SH In ThisWorkbook.Worksheets SH.Unprotect Password:="123" Next SH End Sub

السلام عليكم أو إستخدم هذا الكود يأدي نفس الغرض وبدون معادلة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Or Target.Row < 3 Then Exit Sub If Target.Value = Empty Then Target.Offset(0, 9).Value = Empty: Exit Sub If Not Intersect(Target, Range("A3:A2000")) Is Nothing Then For S = 2 To Sheets(2).Range("A15000").Row If Target.Value = Sheets(2).Cells(S, 1).Value Then Target.Offset(0, 9).Value = Sheets(2).Cells(S, 2).Value Exit For End If Next S Exit Sub End If End Sub

السلام عليكم تفضل هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Or Target.Row < 3 Then Exit Sub If Target.Value = Empty Then Target.Offset(0, 9).Value = Empty: Exit Sub If Not Intersect(Target, Range("A3:A2000")) Is Nothing Then Target.Offset(0, 9).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC[-9],list,2,FALSE)),"""",VLOOKUP(RC[-9],list,2,FALSE))" Exit Sub End If End Sub وهذا المرفق وأما كلمة تخليق أراى أن تستخدم غيرها تركيب أو تأليف هكذا كلمات والسلام عليكم تركيب معادلة بالكود_ali.rar

السلام عليكم كلك أفكار أستاذ بن عليه بارك الله فيك وزادك من علمة وفضله تقبل مروري

السلام عليكم إستخدم هذا الكود Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)"

السلام عليكم استاذي الحبيب محمد صالح حفظك الله ورعاك " طريقة تضليل الكود الغير مستخدم " اعتبرها الهديه الثانية وياريت تكثر الهدايا هداياك قيمة لاتقدر بثمن بارك الله فيك ووهب لك ماتتمنى

السلام عليكم وإستخدم هذا الكود لعمل قائمة منسدلة بأوراق المصنف في خلايا (i7) و ( J7) مهما أضفت أوراق ستظهر في القائمة المنسدلة عند فتح الملف هذا الكود في حدث ThisWorkbook Private Sub Workbook_Open() Call Alidroos End Sub وهذا الكود حطه في مودويل Public Sub Alidroos() For Each Sh In ActiveWorkbook.Worksheets SH_ALI = SH_ALI & "," & Sh.Name Next Sh Sheets(1).Activate With Range("I7,J7").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=SH_ALI End With End Sub والسلام عليكم

السلام عليكم الصورة الظاهره عندي ضفدع برماوي ههههههههه ارجو ارفاق الصورة

السلام عليكم أسأل الله ان يوفقك دنيا واخرة طريقة تضليل الكود الغير مستخدم معلومة كنت اتمناها فأعتبرها إضافه من قبلك للإكسل لجهلي التام بها ولي استفسار اخر استاذ محمد صالح وهو هل اقدر احتفظ بأدواتي في محرر الفيجول ادواتي يعني المعادلات والمتغيرات التي استخدمها في صياغة الاكواد بإستمرار يعني عند كتابة كود اريد استخدم on error resume next وغيرها تكون الجمله موجوده اختارها من القائمة فتكتب في السطر الواقف عليه في الكود بارك الله فيك

السلام عليكم بعد اذن استاذي الحبيب يحيى حسين هذا الكود حطه في حدث الصفحة الرئيسية Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$J$5" Then Application.Run ("ALI"): Cancel = True: Exit Sub End Sub هذا للنقر مرتين لعملية الترحيل وهذا الكود حطه في ماكرو Public Sub ALI() On Error Resume Next Application.ScreenUpdating = False Dim ALI_Range, R1, R2 As Range Dim sh, s, ASC As Worksheet Q = æÑÞÉ1.Range("J7").Value P = æÑÞÉ1.Range("I7").Value Set sh = Sheets(Q) Set s = Sheets(P) Set ASC = Sheets(1) With sh T = .Cells(1000, 1).End(xlUp).Row + 1 Set R1 = ASC.Range(Cells(7, "B"), Cells(7, "C")) Set R2 = ASC.Cells(7, "F") Set ALI_Range = Union(R1, R2).Copy .Cells(T, 1).PasteSpecial xlPasteValues .Application.CutCopyMode = False End With With s T = .Cells(1000, 1).End(xlUp).Row + 1 ASC.Range(Cells(7, "E"), Cells(7, "F")).Copy .Cells(T, 1).PasteSpecial xlPasteValues .Application.CutCopyMode = False End With Application.ScreenUpdating = True End Sub ============================== هل يوجد طريقة للترحيل بطريقة استطيع فيها ترحيل اختياري بما معناه (b7,c7,f7)الى صفحة . ومرة اخرى (f7,e7) الى صفحة ثانية الرجاء دوما الترحيل الى السطر السابع " إقتباس" ============================== هذا هو عمل الكود والسلام عليكم وهذا المرفق ترحيل_ALI.rar

استاذي الحبيب وبرضه مثل ماقلت جربت سابقاً اعلنت المتغير Dim thedate As Variant ونفس الخطاء يظهر استاذي الحبيب محمد صالح انا شغال على الكود طبيعي في ملفاتي والمشكله حاصله عند الاخ الفاضل AbedElkader الذي هو متواجد في هذا الموضوع انا حبيت اعرف اين الخطاء كي نتلافى مثل هكذا مشاكل

السلام عليكم الاخ اوفيس 2003 اطلع على الفيديو الاخ نزاهه اي تنسيق تقصد ؟؟؟ شرح.rar