اذهب الي المحتوي
أوفيسنا

اشرف السيد

عضو جديد 01
  • Posts

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

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

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

2 Neutral

عن العضو اشرف السيد

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

  • Gender (Ar)
    ذكر
  • Job Title
    مدرس
  • البلد
    مصر

اخر الزوار

846 زياره للملف الشخصي
  1. الف شكر على مجهودك الرائع وجزاك الله كل خير فى الدنيا والاخرة
  2. Sub طابعة() ' ' طابعة Macro ' Macro recorded 31/03/2014 by ashlolo 'ترتيب عزمود E ابجديا Columns("E:E").Select Range("E5").Activate Selection.Sort Key1:=Range("E5"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'SAVE workbook ActiveWorkbook.Save 'حفظ مدى معين Range("A5:J22").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 'فتح ملف موجود على الجهاز Range("H23").Select Workbooks.Open Filename:="C:\Users\ashlolo\Documents\صفثان.xls" 'اعداد الصفحة With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "$A$1:$J$983" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.393700787401575) .RightMargin = Application.InchesToPoints(0.393700787401575) .TopMargin = Application.InchesToPoints(0.393700787401575) .BottomMargin = Application.InchesToPoints(0.393700787401575) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed End With End Sub Sub Macro2() ' Macro2 Macro ' Macro recorded 31/03/2014 by ashlolo 'جعل الناففذة ملء الشاشة Application.DisplayFullScreen = True 'اغلاق شاشة ملء الشاشة Application.DisplayFullScreen = False 'البحث عن نص ما داخل الشاشة Cells.Find(What:="enter", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _ :=True, SearchFormat:=False).Activate 'قص بيانات معينة لمدى Range("B1:F6").Select Selection.Cut 'لصق بيانات Range("I15").Select ActiveSheet.Paste 'نسخ بيانات ولصقها Selection.Copy Range("I1").Select ActiveSheet.Paste Application.CutCopyMode = False 'اظهار الدوائر الحمراء Range("H3:H52").Select ActiveWindow.SmallScroll Down:=-23 Range("H3:H52,J3,J3:J52").Select Range("J3").Activate Selection.FormatConditions.Delete Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ Formula1:="15" Selection.FormatConditions(1).Interior.ColorIndex = 22 'مسح بيانات لمدى بيانات Cells.Select Selection.ShapeRange.Item(1).Hyperlink.Follow NewWindow:=False, AddHistory _ :=True Range("G3:J6").Select Selection.ClearContents 'اظهار المربع الحوارى لراس وتذييل الصفحة With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "$A$1:$J$983" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "&P" .RightHeader = "" .LeftFooter = "الحمد لله" .CenterFooter = "" .RightFooter = "الله اكبر" .LeftMargin = Application.InchesToPoints(0.393700787401575) .RightMargin = Application.InchesToPoints(0.393700787401575) .TopMargin = Application.InchesToPoints(0.393700787401575) .BottomMargin = Application.InchesToPoints(0.393700787401575) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed End With 'لحذف الفواصل بين الصفحات ActiveSheet.VPageBreaks(1).Delete 'لوضع كلمة سر للبرنامج Sheets("اختصارات").Select ActiveWorkbook.Password = "ashlolo111" 'ترتيب النوافذ راسيا Range("B2:I13").Select Windows.Arrange ArrangeStyle:=xlTiled 'ترتيب النوافذ افقيا ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal Windows.Arrange ArrangeStyle:=xlHorizontal 'لجعل نافذة واحدة هى النشطة ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlTiled 'لجعل اتجاة الورقة من اليسار لليمين ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal ActiveSheet.DisplayRightToLeft = False 'لجعل اتجاة الورقة من اليمين لليسار ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal ActiveSheet.DisplayRightToLeft = True 'لوضع حماية لورقة العمل ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'لفك حماية ورقة العمل ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal ActiveSheet.Unprotect 'اخفاء شريط الصيغة اسم البرنامج فى شريط المهام ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlNormal With Application .DisplayFormulaBar = False .ShowWindowsInTaskbar = False End With 'اخفاء شريط اوراق العمل ActiveWindow.DisplayWorkbookTabs = False 'اخفاء شريط القوائم Range("G7").Select Application.CommandBars("Worksheet Menu Bar").Visible = False 'اظهار جميع الاعمدةالمخفية Cells.Select Selection.EntireColumn.Hidden = False 'بحث عن كلمة Enter داخل ورقة العمل Range("L19").Select Cells.Find(What:="enter", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ True, SearchFormat:=False).Activate 'مسح البيانات لمدى معين Range("G15:J21").Select Selection.ClearContents 'اظهار شريط الصيغة ActiveWindow.View = xlNormalView Application.DisplayFormulaBar = True 'اضافة مشغل الموسيقى ActiveSheet.OLEObjects.Add(ClassType:="WMPlayer.OCX.7", Link:=False, _ DisplayAsIcon:=False).Select ActiveSheet.Shapes("WindowsMediaPlayer1").Select 'حذف مشغل الموسيقى ActiveSheet.Shapes("WindowsMediaPlayer1").Select Selection.Delete 'تكبير الشاشة ActiveWindow.WindowState = xlMaximized 'تصغير الشاشة Application.WindowState = xlMinimized 'استعادة الشاشة Application.WindowState = xlNormal ' End Sub Sub Macro3() ' ' Macro3 Macro ' Macro recorded 31/03/2014 by ashlolo ' ' للخلية لوضع خليفة لون With Selection.Interior .ColorIndex = 3 .Pattern = xlSolid End With 'لازالة خليفة اللون على الخلية Range("O20").Select Selection.Interior.ColorIndex = xlNone 'لوضع حدود للخلايا Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With 'لدمج خليتين Range("N5:O5").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge ' End Sub 'لتوسيط النص فى الخلايا و جعل اتجاة الكتابة من اليمين لليسار Cells.Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlRTL .MergeCells = False End With 'لترتيب البيانات تصاعديا من اعلى لاسفل بناء على عمود معين وهو L Range("L2:O17").Select Selection.Sort Key1:=Range("L2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'اظهار شريط الاوراق ActiveWindow.DisplayWorkbookTabs = True 'زوم للشاشة ActiveWindow.Zoom = 200 'زوم للشاشة ActiveWindow.Zoom = 100 'جعل محتوى الخلية بزاوية 45 Range("P7").Select ActiveCell.FormulaR1C1 = "" Range("O8").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 45 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlRTL .MergeCells = False End With 'جعل الخلية الخط غامض Selection.Font.Bold = True 'الخط عريض وحجمه 12 Range("N9:P13").Select Selection.Font.Bold = True With Selection.Font .Name = "Arial" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With 'لنسخ تنسيق نص ما وتنسيقه على نص ىخر Range("I17").Select Selection.Copy Range("O11:P15").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False 'تعبئة تلقائية Range("M13").Select Selection.AutoFilter Range("B2:N11").Select Selection.AutoFilter Selection.AutoFilter Field:=13, Criteria1:="<15", Operator:=xlAnd ActiveSheet.ShowAllData Selection.AutoFilter Range("E2:L9").Select Selection.AutoFilter Selection.AutoFilter Field:=8, Criteria1:="<15", Operator:=xlAnd Selection.AutoFilter 'انشاء ارتباط تشعبى لاكثر من صفحة ActiveSheet.Shapes("AutoShape 76").Select Selection.ShapeRange.Item(1).Hyperlink.SubAddress = "Sheet2!A1" Selection.ShapeRange.Item(1).Hyperlink.SubAddress = "Sheet4!A1" Sub Macro4() ' ' Macro5 Macro ' Macro recorded 31/03/2014 by ashlolo ' 'مسح بيانات Range("G14:L20").Select Selection.ClearContents ' Range("G2").Select ActiveSheet.Paste End Sub
  3. بسم الله الرحمن الرحيم تحية خاصة لكل اعضاء المنتدى والمشرفين عليه اقدم لكم ملف للعفشة واعمال الامتحانات الخاصة بمرحلة النقل للمرحلة الاعدادية العفشة والمحاضر.rar
  4. البرنامج يعمل على ويندوز سفن لغة الارقام العربية.rar
  5. حمل الملف من الرفقات البرنامج يحول الارقام العربية الى انجليزية على ويندوز سفن وليس اكس بى لغة الارقام الانجليزية.rar
  6. ماكرو بحث Sub Test() Dim sh As Worksheet Dim Lr As Long Dim i As Integer Dim Name As String, Clon As String Set sh = ThisWorkbook.Sheets("Sheet1") 1 Clon = InputBox(prompt:="اختيار عمود البحث.", _ Title:="اختيار عمود", Default:="اكتب اسم العمود الذي تريد البح فيه هنا") If Clon Like "[A-z]" Then Lr = sh.Cells(sh.Rows.Count, Clon).End(xlUp).Row GoTo 2 Else MsgBox " A-Z يجب ان تكون الحروف " GoTo 1 End If 2 Name = InputBox(prompt:="ادخل الاسم او الرقم ", _ Title:=" بحث حسب العمود المختار", Default:="اكتب الاسم او الرقم الذي تبحث عنه هنا") For i = 1 To Lr If sh.Range(Clon & i) = Name Then sh.Range(Clon & i).Select Exit For ElseIf i = Lr ThenMsgBox "الاسم الذي ادخلته غيرموجود" End If Next End Sub
  7. application.commandbars("workbook tabs").showpopup يتم وضع هذا الكود فى ماكرو ثماظهار شريط للماكرو ثم ضغطة يمين على ايقونة الماكرو واختيار assign Macro واختيار اسم الماكرو الذى انشائته ز فتظهر شريط باسماء الاوراق العمل على الشاشة ويتم اختيار اى ورقة او صفحة تريدها ولكن لها سلبية واحدة فقط وهى ان هذا الشريط يبقى مفتوح كلما فتحت اى ملف اكسيل مرة اخرى وعند الضغط عليه يقوم باستدعاء الشريط من البرنامج فيفتح الملف الاساسى توجد طريقة ثانية لاظهار اوراق العمل بالضغط على ازرار التحكم بزر الفارة الايمن فتظهر الاوراق ارجو ان اكون وفقت
  8. السلام عليكم لتعديل هوامش الصفحة ونوع الورقة وحجمها ممكن من الريجسترىregistry وتدخل على software ثم الاوفيس ثم الاكسيل ثم ............. ثم تعمل تصدير للملف لتحفظه بصغية reg ثم تضغط على الملف فيلزم الاكسيل فى بداية الفتح بالاعدادات التى غيرتها
×
×
  • اضف...

Important Information