(موضوع مميز ) بعض الاكواد المنفصلة قد تهم البعض

[فراس البزاز]

عمل اكثر من رائع ومفيددد جدا جزاكم الله خيرا

 

تحياتي للجميع

[privilege]

 

الاخ العزيز يحياوي :

اشكرك

ارفق ملف خاص لك

كنت قد حصلت عليه من احمد المواقع ( واعتذر لانني لااتذكر الموقع )

ارجو ان تقوم بدراسته وتعلمنا

والحقيقة انا لم استخدمه مطلقا ( ربما بسبب قلة خبرتي )

ننتظر اجابتك

وفقك الله

ياسر الحافظ

 

مشكور أخى الكريم 

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

وفقكم الله جميعا

[وليد فتحي]

بجد عمل أكثرمن رائع

ومجهود جبار من الاخوة المشتركين بالموضوع

جزاكم الله جميعم على هذا الموضوع

وعذرا لاثراء الموضوع مرة اخري للاستفادة منه لما يحتوية من كنوز

[وليد فتحي]

 

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

مرفق الملف

 

 

ياريت يتم ذلك للاستفادة اكثر من الموضوع

[HICHAM MASINOUS]

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

[وليد فتحي]

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

اللهم آمين

[أبو عبد الملك السوفي]

السلام عليكم

ماشاء الله أكود ممتازة جزيت خيرا أستاذنا محمد

[الزباري]

بصراحة مجهود أكثر من رائع.. يدل على أن صاحبه أكثر تنظيما وترتيبا.. بالإضافة إلى ما يتحلى به من الذكاء والعبقرية.. تحياتي

             

[محمد الزريعي]

الأخوة الأعزاء  أنني قمت بعمل كود يقوم بإخفاء  الصفوف  التي لا تحتوي على قيم في عمود معين

حيث أن الخلايا الموجودة في هذا العمود تمثل ( كل خلية تمثل شيت ) يعني عندي 50 خلية  و50 شيت   .. اسماء الشيت مرقم من 1 الي 50

 

قمت بإخفاء الصفوف  ولكن  لم استطيع اخفاء الشيتات  كما هو في التالي :

Dim rng As Range
Dim cell As Range

If ToggleButton1.Value = True Then
   ToggleButton1.Caption = "S H O W"
    Set rng = Range("j6:j55")
      For Each cell In rng
        If cell.Value = 0 Or cell.Value = "" Then
           cell.EntireRow.Hidden = True
        End If
      Next cell
Else
ToggleButton1.Caption = "H I D  E "
    Set rng = Range("j6:j55")
      For Each cell In rng
        If cell.Value = 0 Or cell.Value = "" Then
           cell.EntireRow.Hidden = False
        End If
      Next cell
End If

 

 

المطلوب   كيف اخفي الشيت  بناء على قيمة الخلية  في عمود معين

 

 

يعني الخلية  j6   أذا كانت صفر تختفي  الورقة  التي اسمها  "3"

والخلية j7  أذا كانت صفر تختفي الورقة التي اسمها  "4"

والخلية j8 إذا كانت صفر تختفي الورقة التي اسمها "5"

تم تعديل سبتمبر 17, 2013 بواسطه masdel

[أبو عبد الملك السوفي]

السلام عليكم

يرجى من السادة فريق الموقع تثبيت الموضوع لسهولة الرجوع اليه

[فتحى ابوالفضل]

جزاكم الله كل خبر

[ابو مازن المصري]

مشكور ايها الاخوة علي كل هذة الاعمال الطيبة ...اخوكم   ... ابومازن المصري

[محمود ربيع]

عمل رائع متكامل لايعيبه سوي جهلنا به --- بسم الله ماشاء الله بارك الله فكم

[أ/حكيم]

_{موضوع مميز فعلا بارك الله فيكم ....}

[مصطفي سعد]

جزاك الله خيرا

[اسلام سيد]

جزاكم الله خيرا

[علي المصري]

 

 

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

لكني قمت بالتعديل عليه ليقوم بفرز القيم اولا ثم يقوم بالحذف و بالتالي لن تضطر الى ان تكون القيم مرتبة ارجوا ان يعجبك الكود

 

تسلم إيدك على التعديل الجميل ده

أكيد يعجبني و يعجب غيري طالما من تعديلك أخي الكريم

و بما إن النهاردة أول يوم سبت يكون إجازة عندنا في محافظة الشرقية

فأنا فاضي شوية النهاردة

الكود المرفق يقوم بعمل حماية لخلايا في الورقة بدون حماية الورقة نفسها

يعني لو عندك أكثر من نطاق و فيها معادلات أو حتى ما فيهاش

و تريد حمايتهم من التغيير بدون الحاجة لحماية الورقة

فالكود ده ممتاز في هذا المجال

 

 

سؤال للعباقرة

اعضاء المنتدى

هل يمكن عمل تعديل في هذا الكود بيث يخفي المعادلات الموجود بالخلية ولا يخفي ناتج المعادلة ( الدالة )

[علي المصري]

كود يوضع في زر امر لحذف الصفوف التي بها ارقام لا تبداء ب 3

Sub ss()
Application.ScreenUpdating = False
For i = 5 To 100
If Mid(Cells(i, 1), 1, 1) <> 3 Then
Cells(i, 1).Value = ""
End If
Next i
Range("A5:A100").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
 Range("A1").Select
 Application.ScreenUpdating = True
End Sub

بفرض ان الارقام في العمود A في المجال A5:A100

ويمكن زيادة المدى

المرفق 2007 2003

والله اعلم

 

شكرا جزيلا على هذا الكود الرائع

 

بعد اذن حضرتك

عملت تعديل على الكود بحيث يخفي الصفوف الفارغة - أو يظهرها مرة أخرى

Sub ss()
Application.ScreenUpdating = False
For i = 5 To 100
If Mid(Cells(i, 1), 1, 1) = "" Then
Cells(i, 1).Value = ""
End If
Next i
Range("A5:A100").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.EntireRow.Hidden = True
 Range("A1").Select
 Application.ScreenUpdating = False
End Sub

Sub ss2()
Application.ScreenUpdating = False
For i = 5 To 100
If Mid(Cells(i, 1), 1, 1) = "" Then
Cells(i, 1).Value = ""
End If
Next i
Range("A5:A100").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.EntireRow.Hidden = False
 Range("A1").Select
 Application.ScreenUpdating = False
End Sub

ss   اخفاء

ss2  اظهار

 

 

شكرا

إخفاء وإظهار الصفوف التي الفارغة.rar

[علي المصري]

قمت بتجربته الآن  يعمل بشكل جيد

اما بعد عمل حماية للورقة وجدت الكود لا يعمل

ولكنه لا يعمل

ارجو الافادة والتعديل

شكرا

[عبدالله المجرب]

السلام عليكم 

اخي علي 

ضع سطر فك الحماية في بداية الكود وسطر إعادة لحماية في نهاية الكود

[علي المصري]

اخي عبدالله المجرب

 

هل هذا ما تقصده

Sub ss()
Application.ScreenUpdating = False
ActiveSheet.Unprotect
For i = 5 To 100
If Mid(Cells(i, 1), 1, 1) = "" Then
Cells(i, 1).Value = ""
End If
Next i
Range("A5:A100").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.EntireRow.Hidden = True
 Range("A1").Select
 ActiveSheet.Protect
 Application.ScreenUpdating = True
 
End Sub

Sub ss2()

Application.ScreenUpdating = False
ActiveSheet.Unprotect
For i = 5 To 100
If Mid(Cells(i, 1), 1, 1) = "" Then
Cells(i, 1).Value = ""
End If
Next i
Range("A5:A100").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.EntireRow.Hidden = False
 Range("A1").Select
 ActiveSheet.Protect
 Application.ScreenUpdating = True
 

تم ولكن يستطيع اي شخص بمجرد ما يضغط على إلغاء حماية الورقة يستطيع التعديل على محتوياتها

ولكني اريد حماية برقم سري

شكرا على متابعتك للموضوع

[علي المصري]

كود لادراج اسماء أوراق العمل الموجودة بملف اكسل ( ادراجها مع عمل ارتباط تشعبي لها )

Option Explicit

Sub ListAllSheets2()
 
Dim sht As Worksheet
Dim i As Integer
i = 2
 
For Each sht In Worksheets
i = i + 1

    ActiveSheet.Hyperlinks.Add _
        anchor:=Cells(i, 2), _
        Address:="", _
        SubAddress:=sht.Name & "!a1", _
        TextToDisplay:=sht.Name
 
Next sht
End Sub

ارتباط تشعبي.rar

[memad]

السلام عليكم 

انا كل لما افتح الشيتات الي فيها اكواد تظهرلي الرسالة دي المرفقة و مش عارف اعمل اية معا اني دخلت علي الاوبشن بتاعت الاوفس وعملت انيبول للماكرو و انا بستخدم اكسل 2010 

تم تعديل فبراير 6, 2014 بواسطه memad

[ABO YAHIA2014]

اليكم كود لتلأم العمود لمحتوى النص

بمعنى عند كتابة اسم طويل بالخليه تتوسع اتوماتيك

ينحط الكود في حدث workbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
ActiveSheet.Columns(Target.Column).AutoFit
End Sub

السلام عليكم

اخي الكريم لو ممكن كيف اضيف الكود و باي مكان و التفعيل لو ممكن الطريقة والله يعطيك العافية

[تومي محمد]

السلام عليكم

الاخوة الافاضل

هذا كود لعمل باسورد حماية لكافة اوراق الملف

انشاء الله يفيدكم

 

Option Explicit
Sub ProtectAllSheets()
Dim pwd As String, pwd2 As String
Dim ws As Worksheet
        Do
        pwd = Application.InputBox("ادخل الباسورد?", "عمل باسورد للصفحات", Type:=2)
            If pwd = "False" Then Exit Sub
        pwd2 = Application.InputBox("اعد ادخال الباسورد للتأكيد ?", "التأكد من الباسورد", Type:=2)
            If pwd2 = "False" Then Exit Sub
        If pwd = pwd2 Then Exit Do Else MsgBox "عفـواً الباسور غير مطابق"
    Loop
    For Each ws In Worksheets
        ws.Protect Password:=pwd
    Next ws
End Sub

وهذا الغاء باسورد الحمايه

Option Explicit
Sub UnProtectAllSheets()
Dim pwd As String, ws As Worksheet
On Error Resume Next
pwd = Application.InputBox("الرجاء ادخال الباسورد لاالغاء الحمايه عن كافة الاوراق?", "الغاء الحماية", Type:=2)
If pwd = "False" Then Exit Sub
    For Each ws In Worksheets
        ws.Unprotect Password:=pwd
        If ws.ProtectContents = True Then
            MsgBox "الباسورد غير صحيح لم يتم الغاء الحماية"
            Exit Sub
        End If
    Next ws
End Sub

مرفق ملف تجربه

تحياتي

 

بارك الله فيك على العمل ............لكن..........

 

لاكمال المجهود تمام التمام  ان يكون الشرح والخطاب  للمبتدئين

1- اين اكتب هذا الكود بعد عدة تجارب عرفت ان يكتب في ورقة العمل .

2- رقم الدخول ماهو؟

3- كل الكلمات العربية تظهر عندى في محرر الفيجوال كعلامات استفهام لا استطيع قراءتها

 

والسلام عليكم وحفظك الله وتقبل منى ما قلته