الاستاذ مجدى
بعض الاكواد المنفصلة للفجوال بيزك للاكسل 613623
عزيزي الزائر / عزيزتي الزائرة يرجي التكرم بتسجبل الدخول اذا كنت عضو معنا
او التسجيل ان لم تكن عضو وترغب في الانضمام الي اسرة المنتدي
سنتشرف بتسجيلك
شكرا بعض الاكواد المنفصلة للفجوال بيزك للاكسل 829894
ادارة المنتدي بعض الاكواد المنفصلة للفجوال بيزك للاكسل 103798

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Uoou_u10


الاستاذ مجدى
هل تريد التفاعل مع هذه المساهمة؟ كل ما عليك هو إنشاء حساب جديد ببضع خطوات أو تسجيل الدخول للمتابعة.



 
الرئيسيةالأستاذ التعليمأحدث الصورضع التسجيلدخولالتسجيل
سبحانك لا علم لنا إلا ما علمتنا أنك أنت العليم
عزيزى الزائر قم بالتسجيل بالمنتدى لمشاهدة باقى الاقسام المهمه
مع تحيات مجدى عبد المنعم محمود يونس ببورسعيد " مدير المنتدى "
أهلا بك من جديد يا زائر آخر زيارة لك كانت في
آخر عضو مسجل Heliany فمرحبا به


 

 بعض الاكواد المنفصلة للفجوال بيزك للاكسل

اذهب الى الأسفل 
3 مشترك
كاتب الموضوعرسالة
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالجمعة فبراير 10, 2017 4:55 am

بعض الاكواد المنفصلة للفجوال بيزك للاكسل


كود صندوق حوار يظهر عند فتح الملف

Private Sub Workbook_Open()

MsgBox ("توضع هنا العبارة التى تريد أن تظهرها عند فتح الملف مع تحيات مجدى يونس")

End Sub

توليد ارقام عشوائية

Sub Random()
Dim myRange As Range
Set myRange = Worksheets("æÑÞÉ1").Range("A1:D5")
myRange.Formula = "=int(RAND()*101)"
myRange.Font.Bold = True
End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالجمعة فبراير 10, 2017 9:55 pm

منع اضافة اوراق جديدة

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
MsgBox "عفوا, لايمكنك اضافة اوراق اخرى", _
vbInformation
Sh.Delete
Application.DisplayAlerts = True
End Sub

حماية ورقة بزر اختيار

Sub yahProtectSheet_Click()
If Sheets("yah").CheckBoxes("Check Box 3").Value = xlOn Then
ActiveSheet.Protect DrawingObjects:=True, Contents:=True
Else
ActiveSheet.Unprotect
End If
End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالجمعة فبراير 10, 2017 10:01 pm

منع الطباعة في بعض الاوراق

Private Sub workbook_BeforePrint(Cancel As Boolean)
Select Case ActiveSheet.Name
Case "ورقة1", "ورقة2"
Cancel = True
MsgBox "عفوا, لايمكنك الطباعة", _
vbInformation
End Select
End Sub

ربط لبل بخلية

Private Sub UserForm_Activate()
Label1.Caption = Range("G4").Value
End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالجمعة فبراير 10, 2017 10:18 pm

كود لالتقاط صورة للشاشة

Sub PrintTheScreen()

Application.SendKeys "(%{1068})"

DoEvents

End Sub

كود لاظهار الرسام

Sub kh_mspaint()

Dim ReturnValue

ReturnValue = Shell("c:\windows\system32\mspaint.exe", 3)

End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأربعاء فبراير 15, 2017 9:11 pm

لجعل ال textbox في الفورم يقرب القيمه التي بداخله

لاقرب رقمين عشرين

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Format(TextBox1, "#.00")
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox2 = Format(TextBox2, "#.00")
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox13 = Format(TextBox3, "#.00")
End Sub


_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأربعاء فبراير 15, 2017 9:18 pm

التحكم فى تنسيق القيم المدخله فى التكست بوكس بوضع علامه عشريه

Private Sub TextBox1_AfterUpdate()
TextBox1.Text = Format(TextBox1.Text, "0.0")
End Sub

هنا نوع التنسيق "0.0" يكون رقم واحد بعد العلامه العشريه
مثال لو حضرتك ادخلت 20 فقط ستجد التكست بوكس اصبح 20.0

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأربعاء فبراير 15, 2017 9:22 pm

ادخلت رقمين عشريين او لم تدخل ارقام عشريه ستجد النتيجة بعد رقم عشرى واحد
طيب لو احنا عايزين رقمين بعد العلامه العشريه الموضوع بسيط جدا هنخلى التنسيق كالتالى "0.00"
شاهد الكود

Private Sub TextBox1_AfterUpdate()
TextBox1.Text = Format(TextBox1.Text, "0.00")
End Sub

طيب لو 3 أرقام عشريه
Private Sub TextBox1_AfterUpdate()
TextBox1.Text = Format(TextBox1.Text, "0.000")
End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأحد فبراير 19, 2017 8:31 am

الاشارة للعمود للصفحة النشطة
Private Sub TextBox2_Change()
Range("a1:a50000")
If TextBox2.Value <> "" Then
ks = WorksheetFunction.CountA(Range("a1:a50000"))
TextBox1.Value = ks
Else
TextBox1.Value = ""
End If
End Sub

الاشارة للعموود لصفحة معينة
Private Sub TextBox2_Change()
Sheets("Sheet1").Range("a1:a50000")
If TextBox2.Value <> "" Then
ks = WorksheetFunction.CountA(Range("a1:a50000"))
TextBox1.Value = ks
Else
TextBox1.Value = ""
End If
End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأحد فبراير 19, 2017 5:17 pm

دالة بسيطة للفرق بين تاريخين بالطريقة المتبعة عندنا في مصر (وبها بعض الاختلاف عن datedif الموجودة في الإكسل)

حيث يتم حساب السن عندنا بطرح أيام التاريخ الأحدث - أيام التاريخ الأقدم وإذا كان الناتج بالسالب يتم استلاف شهر (30 يوم كقاعدة ثابتة)

ونفس الكلام مع الشهور مع استلاف 12 شهر في حالة شهور التاريخ الأحدث أقل من شهور التاريخ القديم

والناتج مجمع كله في خلية واحدة


Function date_diff(oldd As Date, newd As Date) As String

Dim years, months, days As Integer

years = Year(newd) - Year(oldd)

If Month(newd) < Month(oldd) Then

years = years - 1

months = (Month(newd) + 12) - Month(oldd)

Else

months = Month(newd) - Month(oldd)

End If

If Day(newd) < Day(oldd) Then

months = months - 1

days = (Day(newd) + 30) - Day(oldd)

Else

days = Day(newd) - Day(oldd)

End If

date_diff = Format(years, "00") & " عام و " & Format(months, "00") & " شهر و " & Format(days, "00") & " يوم"

End Function


_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأربعاء فبراير 22, 2017 7:02 pm

ظهور اليوزر فورم بدون الفريم الازرق الى من الاعلى الى به علامة الغلق

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long _
, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Sub UserForm_Initialize()

Dim hWnd As Long, Style As Long
hWnd = FindWindow(vbNullString, Me.Caption)
Style = GetWindowLong(hWnd, -16) And Not &HC00000
SetWindowLong hWnd, -16, Style
DrawMenuBar hWnd
End Sub


منع استخدام علامة الغلق

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Cancel = True

End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
فوازنور6




عدد المساهمات : 1
تاريخ التسجيل : 17/03/2017

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالسبت مارس 18, 2017 7:00 pm

عمل في غاية الأهمية جزاك الله كل خير أستاذ
الرجوع الى أعلى الصفحة اذهب الى الأسفل
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالأحد مارس 19, 2017 4:42 pm

الف شكر

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
محمود عبيد




عدد المساهمات : 8
تاريخ التسجيل : 02/04/2017

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالسبت أبريل 29, 2017 3:33 am

شكرا موضوع حميل
الرجوع الى أعلى الصفحة اذهب الى الأسفل
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالثلاثاء أكتوبر 03, 2017 11:19 am

كود لعمل باسورد حماية لكافة اوراق الملف
Option Explicit

Sub ProtectAllSheets()

Dim pwd As String, pwd2 As String

Dim ws As Worksheet

Do

pwd = Application.InputBox("ادخل الباسورد?", "عمل باسورد للصفحات", Type:=2)

If pwd = "False" Then Exit Sub

pwd2 = Application.InputBox("اعد ادخال الباسورد للتأكيد ?", "التأكد من الباسورد", Type:=2)

If pwd2 = "False" Then Exit Sub

If pwd = pwd2 Then Exit Do Else MsgBox "عفـواً الباسور غير مطابق"

Loop

For Each ws In Worksheets

ws.Protect Password:=pwd

Next ws

End Sub



وهذا الغاء باسورد الحمايه

Option Explicit

Sub UnProtectAllSheets()

Dim pwd As String, ws As Worksheet

On Error Resume Next

pwd = Application.InputBox("الرجاء ادخال الباسورد لاالغاء الحمايه عن كافة الاوراق?", "الغاء الحماية", Type:=2)

If pwd = "False" Then Exit Sub

For Each ws In Worksheets

ws.Unprotect Password:=pwd

If ws.ProtectContents = True Then

MsgBox "الباسورد غير صحيح لم يتم الغاء الحماية"

Exit Sub

End If

Next ws

End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالثلاثاء أكتوبر 03, 2017 11:21 am

كود لعمل اوراق جديد بحسب ماتكتبه في

العمود A من السطر الثاني كم تشاء من الاوراق

وعمل ارتباط تشعبي في كل ورقة جديدة العودة الى

الورقه الرئيسية

Option Explicit

Sub CreateSheets()

Dim RNG As Range

Dim c As Range

Application.ScreenUpdating = False

Set RNG = ActiveSheet.Range("A2:A" & Rows.Count).SpecialCells(xlConstants)

For Each c In RNG

If Not Evaluate("ISREF('" & c.Text & "'!A1)") Then

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c.Text

Else

Sheets(c.Text).Move After:=Sheets(Sheets.Count)

End If

Sheets(c.Text).Range("A1").Formula = "=HYPERLINK(""#ورقة1!A1"",""الرئيسية"")"

c.Offset(, 1).FormulaR1C1 = "=HYPERLINK(""#'"" & RC[-1] & ""'!A1"", ""Link"")"

Next c

RNG.Parent.Activate

Application.ScreenUpdating = True

End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
مجدى يونس
Admin
مجدى يونس


عدد المساهمات : 3773
تاريخ التسجيل : 22/02/2013
العمر : 69

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Empty
مُساهمةموضوع: رد: بعض الاكواد المنفصلة للفجوال بيزك للاكسل   بعض الاكواد المنفصلة للفجوال بيزك للاكسل Avatarالثلاثاء أكتوبر 03, 2017 11:29 am

كود عمل باسورد لتنفيذ الماكرو

واذا تعدت المحاولات 3 مرات يقفل الملف

Public ABU_NSSAR As Byte

Private Sub CommandButton1_Click()

الباسورد = "123"

ِABOOD = InputBox("إدخل الباسورد لتنفيذ الماكرو")

If ِABOOD <> الباسورد Then

MsgBox ("الباسورد خطاء (الإدخال الخاطئ اكثر من 3 محاولات يقفل البرنامج)")

ABU_NSSAR = ABU_NSSAR + 1

If ABU_NSSAR > 3 Then

 Application.DisplayAlerts = False

 Application.Quit

End If

Exit Sub

End If

Range("a3").Value = "مع تحيات مجدى يونس"

MsgBox ("تم تنفيذ الماكرو")

End Sub

_________________
لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

بعض الاكواد المنفصلة للفجوال بيزك للاكسل Aaa11
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://magdi54.forumegypt.net
 
بعض الاكواد المنفصلة للفجوال بيزك للاكسل
الرجوع الى أعلى الصفحة 
صفحة 1 من اصل 1
 مواضيع مماثلة
-
» تكبير الخط للفجوال بيزك والتحكم فى مكان الكتابة للبحث عن الاسم
» شرح مبسط للاكسل بالصور وبملف بوربوينت
» فورم بحث وتعديل مباشر
» شرح كيفية عمل شاشة دخول للاكسل بصورة جمالية
» فورم الدخول للاكسل من الفورم بادخال الاسم ورقم التليفون ومعرفة اسم اخر زائر

صلاحيات هذا المنتدى:لاتستطيع الرد على المواضيع في هذا المنتدى
الاستاذ مجدى :: قسم مجموعة الاوفيس :: قسم الاكسل-
انتقل الى: