Ali Mohamed Ali

وعليكم السلام -اهلا بك فى المنتدى طالما انك لم تقم برفع ملف فهناك العديد من الطرق منها : يمكنك مشاهدة هذا الفيديو https://www.youtube.com/watch?v=nF1VNTGzN3c https://www.youtube.com/watch?v=qU1z3jdUZ_g وهذا ايضا رابط للتحويل مباشرة من الوورد الى الإكسيل https://convertio.co/ar/doc-xls/ وهذه طريقة سهلة لتحويل ملفات الورد لإكسيل دون الحاجه لبرامج تحويل الملفات 1- إفتح ملف الورد المراد تحويله لإكسيل word .doc 2- قم بحفظة على صورة ملف بصيغة اتش تي ام ال أو صفحة إنترنت باسم الملف المراد تحويلة file / save as / web page format 3 – قم بفتح ملف اكسيل جديد open new xls 4- اضغط على فتح في قائمة ملف open /brwos/ select file 5- إختار الملف بصيغة الاتش تي ام ال السابق تحويله file html. 6- قم بحفظ الملف ذاته بأختيار صيغة اكسيل ورقة عمل باختيار احد صيغ الأكسيل باصداراته المراد انشاؤها file/ save as/ xls 97/2033 وهذا رابط اخر من داخل المنتدى ناقش نفس الموضوع https://www.officena.net/ib/topic/33342-المطلوب-ملف-وورد-به-جداول-طولية-تحويله-الى-ملف-اكسل/ وهذه فيديوهات كمان لنقل البيانات من الوورد الى الإكسيل بأكواد VBA : https://www.youtube.com/watch?v=9QJXmsczaP8 https://www.youtube.com/watch?v=5IRWMSBmw1w وهذا كود تحويل ايضا Sub importTableDataWord() ‘We declare object variables for Word Application and document Dim WdApp As Object, wddoc As Object ‘Declare a string variable to access our Word document Dim strDocName As String ‘Error handling On Error Resume Next ‘Activate Word it is already open Set WdApp = GetObject(, “Word.Application”) If Err.Number = 429 Then Err.Clear ‘Create a Word application if Word is not already open Set WdApp = CreateObject(“Word.Application”) End If WdApp.Visible = True strDocName = “C:\our-inventory\inventory.docx” ‘Check relevant directory for relevant document ‘If not found then inform the user and close program If Dir(strDocName) = “” Then MsgBox “The file ” & strDocName & vbCrLf & _ “was not found in the folder path” & vbCrLf & _ “C:\our-inventory\.”, _ vbExclamation, _ “Sorry, that document name does not exist.” Exit Sub End If WdApp.Activate Set wddoc = WdApp.Documents(strDocName) If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName) wddoc.Activate ‘define variables to access the tables in the word document Dim Tble As Integer Dim rowWd As Long Dim colWd As Integer Dim x As Long, y As Long x = 1 y = 1 With wddoc Tble = wddoc.tables.Count If Tble = 0 Then MsgBox “No Tables found in the Word document”, vbExclamation, “No Tables to Import” Exit Sub End If ‘start the looping process to access tables and their rows, columns For i = 1 To Tble With .tables(i) For rowWd = 1 To .Rows.Count For colWd = 1 To .Columns.Count Cells(x, y) = WorksheetFunction.Clean(.cell(rowWd, colWd).Range.Text) ‘Access next column y = y + 1 Next colWd ‘go to next row and start from column 1 y = 1 x = x + 1 Next rowWd End With Next End With ‘we don’t need to save the word document wddoc.Close Savechanges:=False ‘we quit Word WdApp.Quit ‘We finally release system memory allocated to the 2 object variables Set wddoc = Nothing Set WdApp = Nothing End Sub

والأخر ايضا يعمل تمام هل لاحظت الصور ؟

اين اسماء العملاء؟ اذا كنت تريد طباعة ما فى الملف -تفضل مثال.xlsm

تفضل اخى الكريم ولتثبيت اى خلية كما تطلب عليك بتحديد الخلية ثم الضغط على f4 لتصيح رقم الخلية بين علامتين الدولار كما ترى بالملف $ مثال.xls

أخى الكريم لاحظ بالصور لا يوجد مشاكل بالتحميل https://up.top4top.net/downloadf-1129unji31-rar.html وايضا هذا رابط اخر على ميديا فاير http://www.mediafire.com/file/5wkob9d35px26mx/كنترول+شيت+2019-ابتدائى+واعدادى-الأستاذ+عبد+البارى.rar

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

احسنت استاذ سليم كود ممتاز جعله الله فى ميزان حسناتك

اخى الكريم الملف كله مرفوع هنا على هذا الرابط وهو تمام وبلا مشاكل https://up.top4top.net/downloadf-1129unji31-rar.html

اخى الكريم لماذا لم ترى الملف ؟ كيف تقول ان هناك اختلاف وهو نفس الملف الذى ارسلته ارسل صورة الإختلاف لو سمحت طالما انك ترى ان هناك اختلاف

تفضل دفتر اليوميه كمال.xlsx

وعليكم السلام تفضل المطلوب.xlsx

هذا هو الملف -كان عليك اخى الكريم رفع الملف لكى تتم الإستفادة للجميع ان شاء الله الشهيدة نهال العقيد.xlsm

تفضل المصنف100.xlsm

يجب عليك ضبط لغة جهازك وذلك من خلال الشرح الموجود على هذا الرابط https://www.officena.net/ib/topic/87988-اللغه-العربيه-في-الاكسيل-2010-لا-تظهر-بشكل-صحيح/?tab=comments#comment-556696

اخى الكريم يمكن تكون المشكلة لديك انت فكما ترى بالصورة هذا من الملف المرسل اليك .

حاول رفع نموذج من الملف على الأقل يحتوى على 20 صفا

الملف ليس به أى أكواد !!!! كما انك لابد من شرح المطلوب بكل دقة على الملف

عليك بعمل ضغط للملف ثم رفعه

أخى الكريم تم التعديل لاحظ بنفسك هذا هو الكود الجديد Sub DatedIf_User() Dim ws As Worksheet, Sh As Worksheet, Mh As Worksheet Dim ShName As String, Rng As Range, C As Range Dim LR As Long, VlDate As Variant Application.ScreenUpdating = False Set ws = Sheets(ActiveSheet.Name) VlDate = ws.Range("E2").Value '---------------------------------- LR = ws.Cells(Rows.Count, "C").End(xlUp).Row ws.Range("F10:H" & LR + 1).ClearContents Set Rng = ws.Range("E10:E" & LR) '---------------------------------- If IsEmpty(VlDate) = True Then MsgBox "من فضلك ادخل تاريخ حساب السن" Exit Sub Else On Error Resume Next For Each C In Rng If C.Value <> "" Then YY = Year(VlDate) y = Year(C.Value) mm = Month(VlDate) m = Month(C.Value) dd = Day(VlDate) D = Day(C.Value) '----------------------- If D > dd And m > mm Then C.Offset(0, 1) = dd + 30 - D C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D <= dd And m > mm Then C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m + 12 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D >= dd And m = mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D >= dd And m < mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m - 1 C.Offset(0, 3) = YY - y '----------------------- Else C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m C.Offset(0, 3) = YY - y End If End If Next End If Application.ScreenUpdating = True End Sub

عليك برفع الملف حتى تتم المساعدة

. ثانية.rar

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

قد تم التعديل من قبل استاذنا الكبير ابراهيم الحداد فى المشاركة الأخرى له منا جميعا كل المحبة والإحترام Sub DatedIf_User() Dim ws As Worksheet, Sh As Worksheet, Mh As Worksheet Dim ShName As String, Rng As Range, C As Range Dim LR As Long, VlDate As Variant Application.ScreenUpdating = False Set ws = Sheets("بيانات الطالبات") VlDate = ws.Range("I5").Value '---------------------------------- LR = ws.Cells(Rows.Count, "E").End(xlUp).Row If LR < 8 Then Exit Sub ws.Range("I8:K" & LR + 1).ClearContents Set Rng = ws.Range("H8:H" & LR) '---------------------------------- If IsEmpty(VlDate) = True Then MsgBox "من فضلك ادخل تاريخ حساب السن" Exit Sub Else On Error Resume Next For Each C In Rng If C.Value <> "" Then YY = Year(VlDate) y = Year(C.Value) mm = Month(VlDate) m = Month(C.Value) dd = Day(VlDate) D = Day(C.Value) '----------------------- If D > dd And m > mm Then C.Offset(0, 1) = dd + 30 - D C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D <= dd And m > mm Then C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m + 12 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D >= dd And m = mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D >= dd And m < mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m - 1 C.Offset(0, 3) = YY - y '----------------------- Else C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m C.Offset(0, 3) = YY - y End If End If Next End If Application.ScreenUpdating = True End Sub

وعليكم السلام تفضل If.xlsx

احسنت استاذى الكريم بارك الله فيك