طلب تحديث معلومات ملف المد والجزر

[husain alhammadi]

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

تحية طيبة لكم جميعًا، أعضاء منتدانا الكرام،

نأمل أن تكونوا بأفضل حال.

كما تعلمون، يُعتبر ملف المد والجزر (Tide & Currents) أحد المصادر الهامة والمفيدة التي نعتمد عليها في المنتدى، خاصة للأعضاء المهتمين بالصيد، الملاحة، أو أي نشاط يتطلب معرفة دقيقة بأحوال البحر وحركة المياه.

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

لماذا نحتاج إلى التحديث؟

       الدقة: ضمان أن تكون التوقعات والأرقام المسجلة في الملف حديثة ومطابقة للتغيرات السنوية.

• الشمولية: إضافة محطات أو مناطق جديدة قد تهم الأعضاء.

• الصلاحية: التأكد من أن الملف يغطي الفترة الزمنية القادمة بشكل كامل.

كيف يمكنكم المساعدة؟

 

1. المراجعة: إذا كانت لديكم خبرة في هذا المجال، نرجو مراجعة البيانات الحالية للتأكد من دقتها.

2. التزويد بالملفات الجديدة: إذا كنتم تمتلكون نسخة محدّثة للعام القادم (أو الفترة الحالية)، نرجو مشاركتها.

3. المصادر الموثوقة: مشاركة روابط أو أسماء لجهات أو برامج توفر بيانات دقيقة وموثوقة للمد والجزر.

نرجو إرسال أي ملاحظات، تعديلات، أو ملفات محدّثة إلى مشرفي القسم أو الرد مباشرة على هذا الموضوع ليتم تجميعها وتطبيق التعديلات اللازمة.

شاكرين لكم تعاونكم المستمر ومساهمتكم القيمة في إثراء منتدانا.

مع خالص التقدير،

tide_scraper.py.xlsm

[husain alhammadi]

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

هل يوجد خطاء في الكود 

Private Sub CommandButton1_Click()
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim conditionValue As Long
    Dim startColumnIndex As Long
    Dim sourceColumnIndex As Long
    Dim NumberOfRows As Long
    Dim sourceRange As Range
    Dim targetRange As Range
    NumberOfRows = 30
    On Error GoTo SheetError
    Set wsSource = ThisWorkbook.Sheets("Sheet4")
    Set wsTarget = ThisWorkbook.Sheets("Sheet3")
    On Error GoTo ErrorHandler
    If IsNumeric(wsTarget.Range("B2").Value) And Not IsEmpty(wsTarget.Range("B2").Value) Then
        conditionValue = CLng(wsTarget.Range("B2").Value)
    Else
        MsgBox "يجب أن تكون القيمة في الخلية B2 رقمًا يمثل الشهر (1-12).", vbCritical
        GoTo CleanUp
    End If
    If conditionValue >= 1 And conditionValue <= 12 Then
        startColumnIndex = 1 + (conditionValue - 1) * 6
    Else
        MsgBox "القيمة خارج النطاق المسموح به (1-12).", vbExclamation
        GoTo CleanUp
    End If
    sourceColumnIndex = startColumnIndex + 2
    Set sourceRange = wsSource.Range( _
        wsSource.Cells(2, sourceColumnIndex), _
        wsSource.Cells(1 + NumberOfRows, sourceColumnIndex) _
    )
    Set targetRange = wsTarget.Range( _
        wsTarget.Cells(5, 3), _
        wsTarget.Cells(4 + NumberOfRows, 3) _
    )
    targetRange.Value = sourceRange.Value
    Application.CutCopyMode = False
    ThisWorkbook.Save
    MsgBox "? تم ترحيل البيانات بنجاح وحفظ المصنف.", vbInformation
CleanUp:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub
ErrorHandler:
    MsgBox "? حدث خطأ غير متوقع: " & Err.Description, vbCritical
    Resume CleanUp
SheetError:
    MsgBox "?? خطأ في أسماء أوراق العمل: تأكد من أن أسماء أوراق العمل هي 'Sheet4' و 'Sheet3' بشكل صحيح.", vbCritical
    Resume CleanUp
End Sub

 

‏‏‏‏الجزر و المد - 999.xlsm