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 ورقة 2 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

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

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