اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

Ali Mohamed Ali

المشرفين السابقين
  • Posts

    11643
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    296

كل منشورات العضو Ali Mohamed Ali

  1. فقط عليك وضع هذا الكود فى موديول عادى Public CntTme As Double Sub StartClock() ActiveSheet.Range("N1").Value = Now() CntTme = Now + TimeSerial(0, 0, 1) Application.OnTime CntTme, "'" & ThisWorkbook.Name & "'!StartClock", , True End Sub ثم بعد ذلك عليك بوضع هذا الكود فى حدث This Workbook Private Sub Workbook_Open() StartClock End Sub لابد ان يكون امتداد الملف Xlsm
  2. تفضل هذا كود لحفظ الملف بصيغة XLSM ويكون اسم الملف موجود بالخليتين M1 & M2 Sub SaveAs() ThisWorkbook.Save 'save current workbook in current name With Application.FileDialog(msoFileDialogSaveAs) .AllowMultiSelect = False .FilterIndex = 2 .InitialFileName = Range("M2").Text & Range("M1").Text 'specify folder - can also include default filename in here too If .Show Then ActiveWorkbook.SaveAs Filename:=.SelectedItems(1), _ FileFormat:=xlOpenXMLWorkbookMacroEnabled End If End With End Sub وهذا كود لحفظ الملف بصيغة PDF Sub PDFActiveSheet() 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") strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" strName = Replace(wsA.Name, " ", "") strName = Replace(strName, ".", "_") strFile = strName & "_" & strTime & ".pdf" strPathFile = strPath & strFile myFile = Application.GetSaveAsFilename _ (InitialFileName:=strPathFile, _ FileFilter:="PDF Files (*.pdf), *.pdf", _ Title:="Select Folder and FileName to save") If myFile <> "False" Then wsA.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=myFile, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False MsgBox "PDF file has been created: " _ & vbCrLf _ & myFile End If exitHandler: Exit Sub errHandler: MsgBox "Could not create PDF file" Resume exitHandler End Sub
  3. اجعل نوع الخط Wingdings 2
  4. تفضل الكود ومعه ملف Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("c8:AH397")) Is Nothing Then If Target.Value = "" Then Cancel = True Target.Value = "P" Range("c8:AH397").Font.Name = "Wingdings 2" Else Cancel = True Target.Value = "" End If End If End Sub ادراج علامة صح.xlsm
  5. بهذه الطريقة التى توضحها يمكن عمل التسلسل بنفسك فليس به مشكلة فهو يكون كده سهلا ففى كل الحالات يكون متتاليا كما ترى تسلسل.xls
  6. لا يمكن هذا فلا يمكن ادخال البيانات فى الإكسيل بالصوت الا بمقابل فهذه خدمة مدفوعة الأجر وليست مجانية https://khamsat.com/technology/data-entry/490222-تفريغ-البيانات-إلى-ملفات-الاكسل واتمنى هذا الفيديو يفيدك فى ادخال البيانات https://www.youtube.com/watch?v=kcrOID5bJsg
  7. وعليكم السلام تفضل تسلسل.xls
  8. يمكنك الإستعانة بهذه الفيديوهات https://www.youtube.com/watch?v=w_lH3sZyUDY https://www.youtube.com/watch?v=x-w_Z6UHCnQ https://www.youtube.com/watch?v=pGVzzvrR2L4 https://www.youtube.com/watch?v=ErocP5o0ARM وهذان ملفان وورد واكسيل تم نقل بيانات شيت الإكسيل الى الوورد كما ترى excel to word.xlsm ser.docx
  9. تفضل اخى الكريم نفس ملف استاذنا الكريم سليم وتم تعديل المطلوب protect first column.xlsm
  10. كيف نقوم بمساعدتك على ملف محمى بكلمة سر
  11. ولكى يعمل هذا الكود معك فى كل صفحة جديدة تفتحها داخل الملف لابد من وضع هذا الكود فى حدث This WorkBook Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call Test End Sub كود ضرب.xlsm
  12. طبعا يمكن العمل فى كل صفحة ولكن لابد من ربطه بزر Sub Test() 'بداية الكود Dim LR As Long 'تحديد LR كمتغير الى اخر سطر به بيانات LR = Range("C" & Rows.Count).End(xlUp).Row Range("E1:E" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR) 'حاصل ضرب العمود C مع العمود D 'واخراج الناتج فى العمود E End Sub 'نهاية الكود
  13. أهلا بك اخى الكريم فى المنتدى يمكنك استخدام خاصية البحث فى المنتدى
  14. وعليكم السلام بالملف موجود كود لحاصل ضرب العمودان C & D واخراج الناتج فى العمود E Sub Test() Dim LR As Long LR = Range("C" & Rows.Count).End(xlUp).Row Range("E1:E" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR) End Sub كود ضرب.xlsm
  15. يمكنك التغيير كما تشاء فى المعادلة الى اى تاريخ تريد وبالنسبة لعلامة السالب يمكنك حلها ببساطة بضرب الناتج فى *-1
  16. تفضل نفس كود استاذنا الكبير سليم له منا كل المحبة والإحترام frais de miss ion 019.xlsm
  17. وعليكم السلام اهلا بك فى المنتدى-تفضل Tab_Ali.xlsx
  18. بارك الله فيك والحمد لله الذى بنعمته تتم الصالحات
  19. تفضل طبعا هيشتغل الضغط على الإنتر بدلا من الزر2.xlsm
  20. يعمل معى كما ترى بالصورة 5الاستيك.rar
  21. من فضلك حدد بالضبط ما يحدث معك بالصور على الملف فالملف يعمل معى تمام
×
×
  • اضف...

Important Information