Akram Galal

شكرا يا أستاذ رجب وأريد طلب أخر وهو أريد عمل زر في ورقة 1 عند الضغط عليها يتم كتابة مايلي في الخلية a3 =1+2 بمعني أنني أريد إدراج المعادلة السابقة في الخلية a3 عند الضغط عل الزر وجزاكم الله خيرا.

الأساتذة االأفاضل الملف لا يعمل مع ويندوز 7 لا يظهر أي شيء عند الضغط علي الزر أرجو المساعدة وشكراً . هذا هو Imports System.ManagementPublic Class License Public Shared Function GetHDDSerialN(Optional ByVal DriverLetter As String = "C") If DriverLetter = "C" Or DriverLetter = Nothing Then DriverLetter = "C" End If Dim myHDD = New ManagementObject("Win32_logicalDisk.DeviceID=""" & DriverLetter & ":""") myHDD.Get() Return myHDD("VolumeSerialNumber").ToString End Function Public Shared Function GetPrimarykey(ByVal HDDSerial As String) Dim Primary_key As String = "" Dim HDD_SeryalN As String = HDDSerial.ToUpper For i As Integer = 0 To HDD_SeryalN.Length - 1 Dim OledChr As Char = HDD_SeryalN(i) Dim newChr As Char If IsNumeric(OledChr) Then newChr = Chr(((Val(OledChr) + i + 5) Mod 10) + 48) Primary_key += newChr Else newChr = Chr(((Val(Asc(OledChr) - 65) + i + 3) Mod 27) + 65) Primary_key += newChr End If Next Return Primary_key End Function Public Shared Function GetFinalKey(ByVal Primarykey As String) As String Dim Finalkey As String = "" Dim Primary_key As String = Primarykey.ToUpper For i As Integer = 0 To Primary_key.Length - 1 Dim OledChr As Char = Primary_key(i) Dim NewChr As Char If IsNumeric(OledChr) Then NewChr = Chr(((Val(OledChr) + i + 3) Mod 10) + 48) Finalkey += NewChr Else NewChr = Chr(((Val(Asc(OledChr) - 65) + i + 5) Mod 27) + 65) Finalkey += NewChr End If Next Return Finalkey End Function Public Shared Function GetSerial(ByVal Key As String) As String Try 'Key= KJDFLKSJDFEPOR Dim NativeSerial As String = "1111122222333334444455555" Dim Serial As String = "" Dim OledChar As Char Dim newChar As Char Dim Index As Integer = 0 For I As Integer = 0 To NativeSerial.Length - 1 Index = I Mod (Key.Length - 1) OledChar = NativeSerial(I) newChar = Chr((Asc(OledChar) - 65 + Asc(Key(Index))) Mod 26 + 65) Serial += newChar Next Return Serial Catch ex As Exception End Try End FunctionEnd Class2_Add FormImports DevExpress.XtraEditorsImports DevExpress.LookAndFeelImports System.ObjectImports Microsoft.Win32Public Class FrmSerial Dim RE = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "t", "10") 'Dim RE1 = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") 'Dim RE2 = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "t", "10") Public selecvalue As Integer Private Sub Login_Load(sender As Object, e As EventArgs) Handles Me.Load LookAndFeel.SkinName = My.Settings.Skin DefaultLookAndFeel1.LookAndFeel.SkinName = My.Settings.Skin If Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") = "exp" Then HyperlinkLabelControl4.Enabled = False If RE Is Nothing Then Microsoft.Win32.Registry.CurrentUser.CreateSubKey("Worldtec") Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "t", "10") Else If RE <= "0" Then ProgressBar1.Position = RE Lex.Text = "انتهت صلاحية استخدام البرنامج" LblSerial.Text = "Not Serial Number" Else RE = RE - 1 Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "t", RE) ProgressBar1.Position = RE Lex.Text = "باقي لك على استخدام البرنامج " & RE & " مرة " FrmMain.Show() End If End If Else End If Dim HDDserial As String = License.GetHDDSerialN T1.Text = License.GetPrimarykey(HDDserial) If Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") = "serial" Then If T1.Text <> "" Then Dim Primarykey As String = License.GetPrimarykey(T1.Text) Dim finalKey As String = License.GetFinalKey(Primarykey) Dim serial As String = License.GetSerial(finalKey) S1.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S1", "") S2.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S2", "") S3.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S3", "") S4.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S4", "") S5.Text = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "S5", "") If S1.Text + S2.Text + S3.Text + S4.Text + S5.Text = serial Then serialtrue() ActeveSerial.Text = "لقد قمت بالفعل بتفعيل الرقم التسلسلي " ActeveSerial.ForeColor = Color.Green HyperlinkLabelControl4.Enabled = False Else serialFalse() ActeveSerial.Text = "الرجاء ادخال الرقم التسلسلي " ActeveSerial.ForeColor = Color.Red End If End If End If If Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "") = "" Then serialFalse() ActeveSerial.Text = "الرجاء ادخال الرقم التسلسلي " ActeveSerial.ForeColor = Color.Red End If End Sub Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) x = Control.MousePosition.X - Me.Location.X y = Control.MousePosition.Y - Me.Location.Y End Sub Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then newpoint = Control.MousePosition newpoint.X -= x newpoint.Y -= y Me.Location = newpoint Application.DoEvents() End If End Sub Public pos As Integer Private Sub Login_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown x = Control.MousePosition.X - Me.Location.X y = Control.MousePosition.Y - Me.Location.Y End Sub Private Sub Login_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove If e.Button = Windows.Forms.MouseButtons.Left Then newpoint = Control.MousePosition newpoint.X -= x newpoint.Y -= y Me.Location = newpoint Application.DoEvents() End If End Sub Sub serialtrue() 'TabLogin. S1.Enabled = False S2.Enabled = False S3.Enabled = False S4.Enabled = False S5.Enabled = False ApplySerial.Enabled = False HyperlinkLabelControl3.Enabled = False FrmMain.Show() Me.Hide() End Sub Sub serialFalse() S1.Enabled = True S2.Enabled = True S3.Enabled = True S4.Enabled = True S5.Enabled = True ApplySerial.Enabled = True HyperlinkLabelControl3.Enabled = True Me.Show() LblSerial.Text = "Not Serial Number" End Sub Private Sub SimpleButton1_Click_1(sender As Object, e As EventArgs) Handles ApplySerial.Click If T1.Text <> "" Then Dim HDDserial As String = License.GetHDDSerialN Dim Primarykey As String = License.GetPrimarykey(T1.Text) Dim finalKey As String = License.GetFinalKey(Primarykey) Dim serial As String = License.GetSerial(finalKey) If S1.Text + S2.Text + S3.Text + S4.Text + S5.Text = serial Then Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S1", S1.Text) Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S2", S2.Text) Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S3", S3.Text) Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S4", S4.Text) Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "S5", S5.Text) Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "serial") serialtrue() LblSerial.Text = HDDserial ActeveSerial.Text = "الرقم التسلسلي صحيح" ActeveSerial.ForeColor = Color.Green Else serialFalse() ActeveSerial.Text = "الرقم التسلسلي خاطئ" ActeveSerial.ForeColor = Color.Red End If End If End Sub Private Sub HyperlinkLabelControl3_Click(sender As Object, e As EventArgs) Handles HyperlinkLabelControl3.Click S1.Text = "" S2.Text = "" S3.Text = "" S4.Text = "" S5.Text = "" End Sub Private Sub HyperlinkLabelControl4_Click(sender As Object, e As EventArgs) Handles HyperlinkLabelControl4.Click Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Worldtec", "statlog", "exp") XtraMessageBox.Show("سوف يتم اغلاق البرنامج قم بإعادة فتحه من جديد", "تجريبي", MessageBoxButtons.OK, MessageBoxIcon.Warning) End End Sub End Class

السلام عليكم ورحمة الله وبركاتة أريد عمل زر عند الضغط علية يقوم بجمع الخلايا من D2 إلي D20 وإظهار النتيجة في الخلية E5 وجزاكم الله خيراً .

مشكور يا أبو الشباب جزاك الله خيراً .

السلام عليكم ورحمة الله وبركاتة السادة الأفاضل أعضاء المنتدى أريد كود لإخفاء كل الأشرطة والقوائم الموجودة في اكسل 2010 حتى شريط العنوان مع العلم أنه عند استخدام أكواد إخفاء يتم الإخفاء فعلاً ولكن عند الضغط علي زر التكبير والتصغير يظهر كل شيء ولذالك أريد إخفاء الكل حتى شريط العنوان الموجود به زر التكبير والتصغير ولكم مني كل الإحتراو والتقدير وجزاكم الله خيراً.

الأساتذة المحترمين جزاكم الله خيراً ولكن أريد عمل ذالك عن طريق الكود ws.Unprotect و ws.protect إن أمكن وسامحوني علي تعبكم وشكراً .

الأساتذة الأفاضل جزاكم الله خيرا و الف شكر علي الرد كود رائع جدا

السادة الأفاضل أرجو منكم ظهور الأرقام التي لا تحتوي علي حرف P في الـ ComboBox1 الموجودة في العمود A في ورقة 1 ولكم منا كل الإحترام والتقدير . وإليكم المرفقات كارنية1.rar

أ/ عياد مشكور علي الرد ولكن الكود لم يعمل أرجوا التوضيح وأين يكتب وشكرا.

جزاك الله كل الخير يا أخي ضاحي هذا هو المطلوب بالفعل والف شكر

أستاذ باسم سعيد أريد أخفاء ورقة واحدة وليس كل الأوراق وجزاكم الله خيرا

مشكور يا أبو الشباب بس أنا أريد حماية الورقة من الكتابة وشكراً .

السلام عليكم ورحمة الله وبركاتة أريد تغيير شاشة دخول أكسل إلي أي صورة أخرى وإليكم الصورة المراد تغييرها في المرفقات ولكم جزيل الشكر . شاشة الدخول.rar

السلام عليكم ورحمة الله وبركاتة تحية طيبة وعطرة علي جميع أعضاء هذا المنتدى العظيم أريد كود حماية يقوم بحماية ورقة1 وورقة2 في نفس الوقت عند الضغط علي الزر وجزاكم الله كل الخير .

جزاكم الله كل الخير وأسف علي التأخير

السلام عليكم ورحمة الله وبركاتة اريد أن يظهر ناتج في الخلية D2 كما هو موجود في المرفقات وجزاكم الله كل الخير. وإليكم المرفقات تاريخ + تعبير رياضي.rar

جزاك الله كل الخير وتسلم علي سرعة الرد

السلام عليكم ورحمة الله وبركاتة تحية طيبة وعطرة علي كل أعضاء هذا المنتدي العظيم أريد كود يقوم بحذف عدد من الأعمدة غير المتجاورة وجزاكم الله كل الخير

أستاذنا الفاضل عيد سعيد وكل عام وأنت بخير وأعداه الله عليك بالصحة والعافية والسعادة وجزالك الله خيرا علي هذه الأعمال الممتازة التي لا تقدر بثمن وجعلك الله دائما سباقاً للخير والعطاء .

أساتذتي الأعزاء عيد سعيد عليكم جميعاً أريد تطبيق الكود السابق علي عدة أوراق في نفس الوقت وجزاكم الله خيراً .

مشكور

في الأعمد Q و R و S و T تكتب فيها العلامة ( ' ) عند الترحيل فما هو السبب أكرمكم الله وجزاكم الله خيرا. واليكم المرفقات المصنف1.rar

السادة الأعزاء أعضاء المنتدي السلام عليكم ورحمة الله وبركاتة لدي مشكلة في ترحيل البيانات فعند الترحيل يرحل هذه العلامة (' ) في الخلايا ما هو السبب جزاكم الله خيرا

السلام عليكم ورحمة الله وبركاتة هل ممكن كلمة سر حماية ورقة العمل

جزاك الله خيرا وزادك من فضله