مختار حسين محمود

نعــــــــــــــــــــــــــــــــــــــــم بس ملفك لا فيه بيانات عليها تنسيق شرطى ولا فيه فورم

لا تستغرب أحيانا نلجأ لها فى بعض الأكواد و البرامج كاختيار رقم أو اسم عشوائى من مجموعة أرقام أو مجموعة أسماء للقيام بعمل شىء ما

السلام عليكم أخى ابراهيم وحشتنا و الله بالنسبة للطلب الأخير أعتقد بأن ادخال 10 أصفار فى خلية يحتاج نوع من التحايل 1 - بمعادلة تعطى أرقام الزيرو 2 - بكود يستخدم الحلقات ويعطى نص مش أرقام 3 - بتنسيق مخصص للخلية وفى انتظار رد أخى و أستاذى الغالى ياسر خليل

الكود يحدد خلية عشوائية ( فى الصف 47 تحديدا و العمود عشوائى من 1 الى 10 ) جرب الكود عملى هتلا قيه يحدد مرة A47 ومرة B47 ومرة C47 ومرة D47 وهكذا حتى J47

بارك الله فيك أخى و حبيبى فى الله و أستاذى الغالى ان كنت بعيدا عنكم فأنت وكل الزملاء فى القلب وعلى بالى دائما ----------------------------------------------------------------------------- مرة تانية أحييك على هذين الكودين الرائعين تقبل تقديرى واحترامى لشخصكم الكريم

الله الله عليك أنت اللى ملكش حل رووووووووووووووووووووووووووووووووو عة يا غالى بارك الله فيك ونفع بك وجعل فى ميزان حسناتك

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

متأسف على تأخر الرد أستاذ ايمان جرب الكود نفسه مع اضافة سطرى تجاوز الأخطاء Option Explicit Sub DeleteAllFilesInAFolder() Dim MyFolder, FSO, FLDR, FileName On Error Resume Next MyFolder = ActiveDocument.Path & "\Test\" Set FSO = CreateObject("Scripting.FileSystemObject") Set FLDR = FSO.GetFolder(MyFolder) For Each FileName In FLDR.Files FileName.Delete True Next On Error GoTo 0 End Sub مع التأكد من وجود المجلد Test فى نفس مسار ملف الورد يعنى جنبه

أهلا بك أستاذ عصام فى أوفيسنا . جرب الكود التالى Sub WorksheetSizes() Dim C As Range, Sh As Worksheet Dim Wb As String, Temp As String, sReport As String Application.ScreenUpdating = False Application.DisplayAlerts = False sReport = "حجم الأوراق" Wb = "mokhtar.xlsx" Temp = ThisWorkbook.Path & Application.PathSeparator & Wb On Error Resume Next Set Sh = Worksheets(sReport) If Sh Is Nothing Then With ThisWorkbook.Worksheets.Add(Before:=Worksheets(1)) .Name = sReport .Range("A1").Value = "اسم الشيت" .Range("B1").Value = "الحجم بالبايت تقريباً" End With End If On Error GoTo 0 With ThisWorkbook.Worksheets(sReport) .Select .Range("A1").CurrentRegion.Offset(1, 0).ClearContents Set C = .Range("A2") End With For Each Sh In ActiveWorkbook.Worksheets If Sh.Name <> sReport Then Sh.Copy ActiveWorkbook.SaveAs Temp ActiveWorkbook.Close SaveChanges:=False C.Offset(0, 0).Value = Sh.Name C.Offset(0, 1).Value = FileLen(Temp) Set C = C.Offset(1, 0) Kill Temp End If Next Sh Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

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

أخى الحبيب ياسر فتحى بارك الله فيك ما شاء الله عليك نشاط ملحوظ فى عز البرد !!

بارك الله فيك و نفع بك تحياتى

هدية جميلة يا أخى ابن الملك نشكرك عليها تحياتى

أشكرك أخ محمود بالنسبة للاستفسار ات الأخيرة طبعا يمكن عند مسح الرقم القومي جعل خانة تاريخ الميلاد خالية تلقائياً و كذلك عند مسح تاريخ الوفاة يتم أيضاً مسح خانة السن عند الوفاة ومدة الوفاة تلقائياً ( بس يستلزمه تغيير فى الأكواد ) ولا تنسى أنه فى الفورم زر اضافة جديد يؤدى لك هذه الوظيفة بالنسبة لرسالة الخطأ لازم تحصل لكونك مسحت بيانات مترابطة مع أو مبنية على بيانات أخرى بالنسبة للصورة هات خصائص Image1 فى الفورم وابحث عن حجم الصورة واحتر الوضع zoom بكدة يكون الطلب 1 و 2 و 5 الباقى يطرح فى موضوع مستقل وهذا رجاء منى أن تطرح نقطة أو نقطتين متشابهتين فى الموضوع الواحد على الأكثر انما جملة طلبات يصرف عنك الآخرين

أشكرك أخى وجدى الحاج على وأهلا و سهلا بك فى أوفيسنا

أخى الغالى عبدالعزيز بارك الله فيك شفانا و شفاكم الله من كل سقم أخى محمود كود ادراج الصورة يعمل عندى بلا أخطاء و هو بالفعل كما طليت اضغط فى الفورم على صورة هيفتح Browser حدد الصورة ثم Open لاحظ أنه مش أى صورة يمكن ادراجها الصورة المفضلة تكون بامتداد jpg ( تم اضافة سطر على الكود لتلافى الأخطاء المحتملة ) اليك التعديل الخاص بحساب السن عند الوفاة و حساب المدة بعد الوفاة تحياتى تاريخ الميلاد من القومى والسن عند الوفاة والمدة بعد الوفاة وادراج صورة.rar

فقط الطلب الخاص بادراج صورة حساب السن عند الوفاة سأعمل عليه لاحقا ان شاء الله أو انتظر أحد الأخوة متأسف أعانى من البرد تحياتى ادراج الصورة فى فورم.rar

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

نعم ضع الكود التالى ملف الورد Option Explicit Sub DeleteAllFilesInAFolder() Dim MyFolder, FSO, FLDR, FileName MyFolder = ActiveDocument.Path & "\Test\" Set FSO = CreateObject("Scripting.FileSystemObject") Set FLDR = FSO.GetFolder(MyFolder) For Each FileName In FLDR.Files FileName.Delete True Next End Sub التطبيق على المجلد Test بتاع أستاذنا ياسر

جرب الكود التالى حدد النطاق المراد تصويره ثم الخلية لوضع الصوره بجوارها Option Explicit Sub paste_Picture() Dim UserRange As Range, OutputRange As Range Dim MyPrompt As String, MyTitle As String MyPrompt = "Select the range you would like to capture." MyTitle = "User Input Required" On Error Resume Next Set UserRange = Application.InputBox(Prompt:=MyPrompt, Title:=MyTitle, Default:=ActiveCell.Address, Type:=8) If UserRange Is Nothing Then End On Error GoTo 0 UserRange.CopyPicture MyPrompt = "Select the range on which you would like to paste." MyTitle = "User Input Required" On Error Resume Next Set OutputRange = Application.InputBox(Prompt:=MyPrompt, Title:=MyTitle, Default:=ActiveCell.Address, Type:=8) If OutputRange Is Nothing Then End On Error GoTo 0 OutputRange.PasteSpecial Selection.Formula = UserRange.Address End Sub

أشكرك أخى محى الدين على دعائك و تثائك الطيب تقبل تحياتى

تفضل شغل الكود و اختر ملف الورد ( قائمة بالاسعار ) ثم اضغط open تحياتى قائمة بالاسعار مختار.rar

الحمد لله أخى الكريم . برجاء اغلاق الموضوع الحالى وطرح طلبك الجديد فيه طالما وصلت الى اجابة سؤالك هنا تحياتى

أستاذى الفاضل محمد بارك الله فيك عشان يشتغل الملف لازم يكون فى الويندوز برنامج Speech يوجد فى النسخ الحديثة من ويندوز 7 فأعلى وعلى بعض الــ XP المتقدم القريب من ويندوز 7 زى XP SP3 تلاقى هذا البرنامج أما القديم فى الــ XP غالبا لا نجد هذه الميزة تحياتى