BoShibh

اسعدك الله يا استاذي

السلام عليكم ورحمة الله وبركاته .. اخواني احتاج مساعدتكم في كود يظهر ويخفي لي صفوف محدده عن طريق زر Toggle انا صممته ( سحب يمين ويسار ) ولكن الكود يظهر اخطا كثيرة Sub ToggleButto() Dim ws As Worksheet Dim xCells As String xCells = "12" 'change this to the row numbers Set ws = ThisWorkbook.ActiveSheet With ws 'TOGGLE "ON" If ToggleButton1.Value = True Then Application.ActiveSheet.Rows(xCells).Hidden = "True" 'update textbox value .Shapes("txtboxOnOff").TextFrame.Characters.Text = "OFF" 'update textbox alignment .Shapes("txtboxOnOff").TextFrame.HorizontalAlignment = xlHAlignRight 'update button background color .Shapes("ToggleButton").Fill.ForeColor.RGB = RGB(232, 27, 34) 'update radio button location .Shapes("radioButton").Left = .Shapes("ToggleButton").Left + .Shapes("ToggleButton").Width - .Shapes("radioButton").Width - 5 Else 'TOGGLE "OFF" ToggleButton1.Value = True Application.ActiveSheet.Rows(xCells).Hidden = "False" .Shapes("txtboxOnOff").TextFrame.Characters.Text = "ON" .Shapes("txtboxOnOff").TextFrame.HorizontalAlignment = xlHAlignLeft .Shapes("ToggleButton").Fill.ForeColor.RGB = RGB(117, 199, 1) .Shapes("radioButton").Left = .Shapes("ToggleButton").Left + 5 End If End With Set ws = Nothing End Sub مرفق لكم ملف العمل CoCo.xlsm

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

تحية طيبة .. اخواني اعضاء الامنتدى طلب وهو دالة تكون مهمتها تحويل خلايا بها 7 ارقام ( اول ثلاثة ارقام عبارة عن كود الجنسية والاربع الارقام الاخيرة رقمه الوظيفي ) واريد تحويل اول ثلاثة ارقام الى حرفين حسب شروط محددة في جدول معين يحتوي على عمدين ( كود الجنسية ورمز الجنسية ) المصنف2.xlsx

الملف موجود على هذا الرابط : https://drive.google.com/file/d/1whKMGSB0XKFf3HKclcoGv54hkaB5iklN/view?usp=sharing

الاخوة الاعزاء .. السلام عليكم ورحمة الله وبركاته .. تحية طيبة لدي ملف تم تصميمه ليتم ارسال رسالة بريد الكتروني مباشرة من الاكسل يتم فيه ارفاق تقرير الى موظفين معينيين يتم تحديدهم وفق دالة VLookUp والمشكلة الان لدي هو ان الكود لا يعمل عند الضغط على كلمة ( ارسال ) والاكواد : Sub mail() Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("Gate") Dim i As Integer Dim OA As Object Dim msg As Object Set OA = CreateObject("outlook.application") Dim last_row As Integer last_row = Application.CountA(sh.Range("M86")) For i = 86 To last_row Set msg = OA.CreateItem(0) msg.To = sh.Range("M76:M79").Value msg.CC = sh.Range("M80").Value msg.Subject = sh.Range("M81:O81").Value msg.Body = sh.Range("M83").Value If sh.Range("L85").Value <> "" Then msg.Attachments.Add sh.Range("L85").Value End If msg.Send sh.Range("L86").Value = "تم الارسال" Next i MsgBox "تم ارسال البريد بنجاح" End Sub وايضا كود ارفاق ملف التقرير ايضا لايعمل مع المحاولات العديدة والكود : Sub Attachment() Dim objFiledialog As FileDialog Dim sFilename As String Dim sFiles As String Dim iFile As Integer Set objFiledialog = Application.FileDialog(msoFileDialogFilePicker) Set wb = ThisWorkbook Set wsPanel = wb.Sheets("Gate") With objFiledialog .AllowMultiSelect = True .ButtonName = "حدد الملف" .Filters.Add "Add Files", "*.*" .Title = "حدد الملف" .InitialView = msoFileDialogViewTiles .InitialFileName = ActiveWorkbook.Path .AllowMultiSelect = True End With If Not objFiledialog.Show() = True Then Exit Sub End If 'If directory is empty If objFiledialog.SelectedItems().Count = 0 Then Exit Sub End If sFiles = "" For iFile = 1 To objFiledialog.SelectedItems.Count DoEvents sFilename = objFiledialog.SelectedItems(iFile) sFiles = sFiles & ";" & sFilename Next sFiles = Replace(sFiles, ";", "", 1, 1, vbBinaryCompare) wsGate.Range("Attach").Value = sFiles End Sub نامل منكم المساعدة في معرفة الخطا اين يكون ومراعاة ترتيب الخلايا من ناحية العمود والصف ومرفق الملف لكم للاطلاع واجراء التجارب ولاحركم الله الاجر المشكلة ان حجم الملف كبير ولم استطع ارفاقه

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

جزاك الله خير ورفع قدرك تحياتي وتقديري لك ❤️

السلام عليكم ورحمة الله .. احتاج مساعدتكم في كود تصدير لملف PDF حيث ان المشكلة في الزر في شيت والصفحة المطلوب تصيرها في شيت اخر واود تعديل هذا الكود الي بالاسفل ليتم تفعيل التصدير بدون مشاكل الشيت الذي يوجد به الزر اسمه " Maker " والصفحة المطلوب تصديرها في شيت باسم " Absence " وايضا هل استطيع حماية الفوتر والهيدر في الشيت برقم سري ولكم خالص التقدير Dim wsA As Worksheet Dim wbA As Workbook Dim strTime As String Dim strName As String Dim strPath As String Dim strFile As String Dim strPathFile As String Dim myFile As Variant On Error GoTo errHandler Set wbA = ActiveWorkbook Set wsA = ActiveSheet strTime = Format(Now(), "yyyymmdd\_hhmm") 'get active workbook folder, if saved strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" 'replace spaces and periods in sheet name strName = Replace(wsA.Name, " ", "") strName = Replace(strName, ".", "_") 'create default name for savng file strFile = strName & "_" & strTime & ".pdf" strPathFile = strPath & strFile 'use can enter name and ' select folder for file myFile = Application.GetSaveAsFilename _ (InitialFileName:=strPathFile, _ FileFilter:="PDF Files (*.pdf), *.pdf", _ Title:="Select Folder and FileName to save") 'export to PDF if a folder was selected If myFile <> "False" Then wsA.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=myFile, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False 'confirmation message with file info MsgBox "PDF file has been created: " _ & vbCrLf _ & myFile End If exitHandler: Exit Sub errHandler: MsgBox "Could not create PDF file" Resume exitHandler End Sub