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

في ٢٧‏/١٢‏/٢٠١٥ at 17:38, ابو راكان العودة said:

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

نعــــــــــــــــــــــــــــــــــــــــم  

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

لا تستغرب 

أحيانا نلجأ لها فى بعض الأكواد و البرامج 

كاختيار رقم أو اسم عشوائى  من مجموعة أرقام أو مجموعة أسماء للقيام بعمل شىء ما

السلام عليكم أخى ابراهيم  وحشتنا و الله 

بالنسبة للطلب الأخير  أعتقد بأن ادخال 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 فى نفس مسار ملف الورد  يعنى جنبه

8 ساعات مضت, عبد العزيز البسكري said:

 

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

الأستاذ الرائع " ياسر العربي "

بارك الله فيك  و جزاك خيرًا و زادك من علمه و فضله على ما تقدمه لاخوانك

تحياتى

أهلا بك أستاذ عصام فى أوفيسنا .

جرب الكود التالى

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  غالبا لا نجد هذه الميزة تحياتى