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

abouelhassan

05 عضو ذهبي
  • Content Count

    1,028
  • تاريخ الانضمام

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

  • Days Won

    1

abouelhassan last won the day on ديسمبر 3 2011

abouelhassan had the most liked content!

السمعه بالموقع

49 Excellent

2 متابعين

عن العضو abouelhassan

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    محاسب

اخر الزوار

1,354 زياره للملف الشخصي
  1. يتم نسخ المعادلة الموجودة فى الخلبة b1 الى اخر العمود شرط وجود بيانات فى العمود a تفضل اخى عسى يفيدك copy formula.xlsm
  2. هل بالامكان تعديل الكود للاحتفاظ بنسخة بتاريخ اليوم بدون حذف القديمة استاذنا لان حدث لى مشكلة عند حذف القديمة مشكور وبارك الله فيك Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strDate As String, DefPath As String Dim FileNameZip, FileNameXlsm Dim oApp As Object ActiveWorkbook.Save If MsgBox("åá ÊÑíÏ ÅäÔÇÁ äÓÎÉ ÇÍÊíÇØíÉ¿", vbInformation + vbMsgBoxRight + vbYesNo, "Zipping") = vbYes Then MakeSureDirectoryPathExists ("D:\BackUp\") If ActiveWorkbook Is Nothing Then Exit Sub DefPath = ActiveWorkbook.Path If Len(DefPath) = 0 Then MsgBox "Plz Save activeworkbook before zipping" & Space(12), vbInformation, "zipping" Exit Sub End If 'If Right(DefPath, 1) <> "\" Then ' DefPath = DefPath & "\" 'End If DefPath = "D:\BackUp\" Dim oFSO As FileSystemObject Dim oFolder As Folder Dim oFile As File Set oFSO = New FileSystemObject Set oFolder = oFSO.GetFolder(DefPath) For Each oFile In oFolder.Files oFile.Delete (True) 'Debug.Print oFile.Name Next 'oFile strDate = Format(Now, " dd-mmm-yy h-mm-ss") FileNameZip = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".zip" FileNameXlsm = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".xlsm" 'On Error Resume Next If Dir(FileNameZip) = "" And Dir(FileNameXlsm) = "" Then ActiveWorkbook.SaveCopyAs FileNameXlsm newzip (FileNameZip) Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameZip).CopyHere FileNameXlsm On Error Resume Next Do Until oApp.Namespace(FileNameZip).items.Count = 1 Application.Wait (Now + TimeValue("0:00:01")) Loop On Error GoTo 0 Kill FileNameXlsm MsgBox "completed zipped : " & vbNewLine & FileNameZip, vbInformation, "zipping" Else MsgBox "FileNameZip or/and FileNameXlsm exist", vbInformation, "zipping" End If End If End Sub Private Sub newzip(sPath) If Len(Dir(sPath)) > 0 Then Kill sPath Open sPath For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 End Sub كل الشكر والاحترام والتقدير
  3. بارك الله فيك استاذنا اشكر حضرتك لمجهودك الكريم جدااااااااااا ولو امكن تعديل المكرو بالملف المرفق لاتمكن من اختيار العمود المرحل اليه المبلغ خالص الشكر والدعاء من القلب والله ماكرو ترحيل بقائمة منسدلة.xlsm
  4. استاذنا الفاضل الجزيرة وحضرتك بكل خير وسعاده بارك الله فيك انا جامع لها من ابدعاتكم الموجودة بالمنتدى مرورك كريم استاذى
  5. جميلة استاذى بس المشكلة عمود sheetname يتم نسخه فى الصفحات وهذا لايمكن عمله بالصفحات اشكرك جداااااااااااااااااااااااااااااا استاى الغالى انا وجدت من خلال البحث بالمنتدى كود نفذ لى المطلوب بس محتاج تعديل بسيط هو امكانيات اختيار العمود m1 او m2 او بس نفذ المطلوب يرحل كل المبالغ للعمود m1 اريده ان باختيار العمود يرحل اليه واريد كود استدعاء الكود هو Sub Transfer() Sheets("ترحيل واستدعاء").Activate For Each F In Range("e3:E27") If F <> "" Then X = F.Value Range(F.Offset(0, -4), F.Offset(0, 0)).Copy LR = Sheets(X).Range("A" & Rows.Count).End(xlUp).Row Sheets(X).Activate Range("A" & LR + 1).Select Selection.PasteSpecial xlPasteValues End If Next F Sheets("ترحيل واستدعاء").Activate Application.CutCopyMode = False Range("b3:f27").ClearContents MsgBox "تم الترحيل الى كل صفحة بنجاح" End Sub كل حبى واحترامى ترحيل واستدعاء.xlsm
  6. الاخوة الاساتذة الافاضل كل عام وحضراتكم بكل خير احببت مشاركتكم هذه المجموعة الجميلة من الازرار التى تستخدم بالفورم وهى تجميع من مشاركات الاساتذة بالمنتدى احترامى اخيكم New_Microsoft_Excel_Worksheet.xlsx المجموعة2 ازرار.xls
  7. الاخوة وجدت كود احتاج تعديله ليناسب البرنامج وهو للاستاذ على محمد على فى هذه المشاركة مش عارف اعدله والله احتاج تعديل الكود ليطبق على الملف المرفق مع خالص شكرى وتقديرى Sub Transfer() Sheets("Main").Activate For Each F In Range("e2:E1000") If F <> "" Then x = F.Value Range(F.Offset(0, -4), F.Offset(0, 0)).Copy LR = Sheets(x).Range("A" & Rows.Count).End(xlUp).Row Sheets(x).Activate Range("A" & LR + 1).Select Selection.PasteSpecial xlPasteValues End If Next F Sheets("Main").Activate Application.CutCopyMode = False Range("A2:E1000").ClearContents MsgBox "تم الترحيل الى كل صفحة بنجاح" End Sub ترحيل واستدعاء.xlsx
  8. الاساتذة الاخوة الخبراء احبائى الاعزاء نظرا لاننى اقوم بتصميم شيت الاكسيل المبرمج الخاص بى فطلباتى زائدة اليومين دول سامحونى رأيت موضوع للعلامة عبدالله بقشير (خبور الخير) اسمه ترحيل الى ماشئت من صفحات احتاج لتطبيقه لدى ملف به عدد من الاعمدة التاريخ والبيان والمبلغ واسم الشيت يختار من ليست و اسم العمود يختار من ليست ولدى مفتاحين واحد ترحيل وواحد استدعاء احتاج كود الترحيل والاستدعاء مع خالص الشكر والاحترام والتقدير اخواتى الافاضل الخبراء ترحيل واستدعاء.xlsx
  9. حبيبي يا استاذى اكثر الله خيرك وبارك لك الله يبارك لك يارب ويديك الصحة والعافية حبيبي والله
  10. اكثر الله خيرك استاذنا حبيبى لن اثقل على حضرتك هاحول اعملها بالفورمات سيلس الكود هو هو ويعمل تمام التمام التمام التمام انا فرحان جدااااااااااااااااااااا بيه ,وادعى لحضرتك من كل قلبى اسعدك الله مثل ما تسعدنا يارب
  11. كل الشكر والتقدير والاحترام لحضرتك حبيبي يا باشا والله,,,معلش لو عايز الكود فى حالة أن مفيش رقم مايكتبش صفر...جزاكم الله خيرا
  12. انا عايز معادلة جمع للصف مكانها مع خالص تحياتي لحضرتك
  13. تمام تمام تمام كنت ناسى اكتب مجموع 1 ومجموع 2 ممكن استاذنا نغير كلمة Global Sum بالجمع عادى للصف مع خالص شكرى وتقديرى
×
×
  • اضف...