Ahmed Emannan

السلام عليكم

=DATE(VLOOKUP(F$1,البيانات,28,FALSE),VLOOKUP(F$1,البيانات,27,FALSE),VLOOKUP(F$1,البيانات,26,FALSE))

هذا الكود صحيح

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

يعني المفروض تخرج القيمة 0

ولكن هنا تخرج القيمة #NUM!

وانا لااريدها ان تخرج اثناء الطباعة

ارجوا الحل

تحياتي

نامل ذلك اخوتي من الاخوة الافاضل

تحياتي

مشكور اخي وبارك الله فيك

اكثر من رائع

تحياتي

مشكور اخي

تحياتي

شكرا اخي يوسف على ردك

انا مبتدي في البرمجة وسيكون خير ان شاء الله لكن اعتقد اخي

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

بالنسبة لسؤالي عن كيفية اخفاء كلمة المرور في مربع كلمة السر

بدلا من تظهر مثلا 1234 كنت اريدها ان تخرج نجمات ********

وجدت الحل في احدى المنتديات الاجنبية وحبيت اني انقل الفائدة للمنتدى الغالي

كلمة سر فتح جميع الاوراق هي 1234

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

وستجدون اخوتي الاعزاء ان مع الكود المطروح سابقا هناك كود طويل وبعض الدوال ارجوا من اخوتي المتقدمين

في البرمجة ان يقوموا بشرح هذه الدوال اذا امكن وما حبيت المس شي في هذه الدوال

فقط ضفت عليه الكود المعدل

اتمنى ان ينال اعجابكم

تحياتي لكم

اخوكم احمد

______________________________________.rar

اريدها ان تظهر مشفر كلمة المرور ******** مجرد نجمات

الصورة في المرفقات

تحياتي

السلام عليكم

اريد ان تكون كلمة السر في هذا الكود مشفرة من DVB الي ***

نامل المساعدة

Sub Button1_Click()
    Dim strPass As String
    Dim iCount As Integer
    strPass = "Secret"

    For lCount = 1 To 3
        strPass = InputBox(Prompt:="الرجاء إدخال كلمة المرور", Title:="كلمة المرور")
        If strPass = vbNullString Then
            Exit Sub
        ElseIf strPass <> "DVB" Then
            MsgBox "كلمة المرور غير صحيحة", vbCritical, "DVB Software"
        Else
            Worksheets("ورقة1").Visible = xlSheetVisible
            Exit For
        End If
    Next lCount

    If lCount = 4 Then Exit Sub

End Sub

مشكور اخي علي مجهودك

تحياتي

لدي سؤال هنا

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

بدل من ان يظهر الرقم يظهر ******** نجمات

تحياتي

السلام عليكم

اخوتي الاعزاء اضع بين ايديكم

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

لااستطيع ايصال المعلومة لكم اكثر اترككم مع الملف المرفق

كلمة السر هي DVB

حروف كابيتال

ورقة 1

Sub Button1_Click()
    Dim strPass As String
    Dim iCount As Integer
    strPass = "Secret"

    For lCount = 1 To 3
        strPass = InputBox(Prompt:="ÇáÑÌÇÁ ÅÏÎÇá ßáãÉ ÇáãÑæÑ", Title:="ßáãÉ ÇáãÑæÑ")
        If strPass = vbNullString Then
            Exit Sub
        ElseIf strPass <> "DVB" Then
            MsgBox "ßáãÉ ÇáãÑæÑ ÛíÑ ÕÍíÍÉ", vbCritical, "DVB Software"
        Else
            Worksheets("æÑÞÉ1").Visible = xlSheetVisible
            Exit For
        End If
    Next lCount

    If lCount = 4 Then Exit Sub

End Sub

Sub Button2_Click()
 Dim strPass As String
    Dim iCount As Integer
    strPass = "ozgrid"

    For lCount = 1 To 3
        strPass = InputBox(Prompt:="ÇáÑÌÇÁ ÅÏÎÇá ßáãÉ ÇáãÑæÑ", Title:="ßáãÉ ÇáãÑæÑ")
        If strPass = vbNullString Then
            Exit Sub
        ElseIf strPass <> "DVB" Then
            MsgBox "ßáãÉ ÇáãÑæÑ ÛíÑ ÕÍíÍÉ", vbCritical, "DVB Software"
        Else
            Worksheets("æÑÞÉ2").Visible = xlSheetVisible
            Exit For
        End If
    Next lCount

    If lCount = 4 Then Exit Sub

End Sub

منقول للفائدة من احد المنتديات الاجنبية

الملف في المرفقات

تحياتي لكم

________________________.rar

مشكور اخي علي توضيحك

تحياتي

السلام عليكم

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

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

منقول للفائدة

كود القفل

Sub mProtect()
Dim cont As Integer
    Do Until cont = Sheets.Count
        cont = cont + 1
        Sheets(cont).Protect (hady)
    Loop
End Sub

Sub mUnprotect()
Dim cont As Integer
    Do Until cont = Sheets.Count
        cont = cont + 1
        Sheets(cont).Unprotect (hady)
    Loop
End Sub

تحياتي لكم

اخي الغالي

هذا الكود يقوم بفتح مجلد المفضلة اذا كان

لديك موقع اكسيل به

منقول للفائدة

تحياتي

Sub GetSpecialFolder()
    Dim WshShell As Object
    Dim SpecialPath As String

    Set WshShell = CreateObject("WScript.Shell")
    SpecialPath = WshShell.SpecialFolders("Favorites")
    MsgBox SpecialPath
    Shell "explorer.exe " & SpecialPath, vbNormalFocus
End Sub

ايضا اخي الغالي لك هذا الكود يفتح الملفات من نوع

Text Document

منقول للفائدة

Sub Get_TXT_Files()
    Dim Fnum As Long
    Dim mysheet As Worksheet
    Dim basebook As Workbook
    Dim TxtFileNames As Variant
    Dim QTable As QueryTable
    Dim SaveDriveDir As String
    Dim ExistFolder As Boolean
    
    SaveDriveDir = CurDir

    ExistFolder = ChDirNet(Application.DefaultFilePath)
    If ExistFolder = False Then
        MsgBox "Error changing folder"
        Exit Sub
    End If

    TxtFileNames = Application.GetOpenFilename _
    (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

    If IsArray(TxtFileNames) Then

        On Error GoTo CleanUp

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        Set basebook = Workbooks.Add(xlWBATWorksheet)

        For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

            Set mysheet = Worksheets.Add(After:=basebook. _
                                Sheets(basebook.Sheets.Count))
            On Error Resume Next
            mysheet.Name = Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
                                    InStrRev(TxtFileNames(Fnum), "\", , 1))
            On Error GoTo 0

            With ActiveSheet.QueryTables.Add(Connection:= _
                        "TEXT;" & TxtFileNames(Fnum), Destination:=Range("A1"))
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1

                .TextFileParseType = xlDelimited
         
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False

                .TextFileColumnDataTypes = Array(1, 9, 1)

              
                .Refresh BackgroundQuery:=False
            End With
        ActiveSheet.QueryTables(1).Delete
        Next Fnum

        On Error Resume Next
        Application.DisplayAlerts = False
        basebook.Worksheets(1).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

CleanUp:

        ChDirNet SaveDriveDir

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

تفضل اخي

Sub OpenUp()
    Workbooks.Open ("C:\MyFolder\MyBook.xls")
End Sub

اخي الغالي

جرب الملف المرفق

امل ان يكون مطلوبك

تحياتي

________________________.rar

مشكور اخي احمد وبارك الله فيك

تسلم وتحياتي ليك

دمت عماراً للمنتدى الغالي

اخوك احمد

مشكور اخي ايسم

تحياتي

مشكور اخي

اخي احمد وجدت الحل

لكن اريد ان يكون الرقم في عمود البحث

بجانب كل خلية

تحياتي

_______________.rar

اخي احمد شكراً وبارك الله فيك

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

الموقعة عليه

ادا امكن اخي احمد

للرفع

السلام عليكم

لدي ملف بالمرفقات به بيانات اريد ان اقوم بوضع رقم الموظف (المعرف)

حيت تخرج جميع بياناته من الاسم للرتبة وغيرها

وكذلك كل العقوبات الموقعة عليه

تحياتي

________.rar

مشكور اخي وبارك الله فيك

امل ارفاق الحل اخي الغالي

تحياتي