هل توقف الابداع عند هذا الحدّ .. ام لا يزال هنالك امل يلوح بالافق ..

**ا بو سليمان** · أكتوبر 25, 2014

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

وكانت المشكله هي انه كيف يتم ترحيل بيانات خليه الى خليه مجاوره وبشكل متتابع على ان تبقى الخليه الاولى هي خليه تتلقى قيمها من مصدر خارجي

ولكن للاسف حتى اللحظة لم اتوصل الى نتائج شافيه كافيه تحقق الهدف من السؤال

فهل جدا في الموضوع جديد لدى عمالقة اوفسينا ؟؟

وهل استطاع احد التوصل الى فكره الترحيل ؟؟

تم تعديل أكتوبر 25, 2014 بواسطه زمزم

**محمود_الشريف** · أكتوبر 26, 2014

أخى فى الله

الأستاذ الكريم // زمزم

اليكم بالمرفقات تجربة لعملية النسخ كل دقيقة

من الخلية B3 الى الخلية D3

اى محتوى بالخلية الأولى يتم نقله الى الخلية الثانية

فى حال كون الملف مفتوح فقط

وجرب بنفسك ( الملف اوفيس 2010 )

الى أن يقوم أحد الأساتذة بالتوصل كاملا لما تريد

وتقبل منى وافر الاحترام والتقدير

تجربة النسخ المكرر.rar

**أبوعيد** · أكتوبر 26, 2014

السلام عليكم

أخي أبوناصر

فهمت من كلامك أنك قد طرحت هذا الموضوع في المنتدى

ياليت لو ترفق لنا روابط الموضوع حتى نكون على اطلاع من الأساس

نصرك الله على أعدائك وجعلك منصورا بالحق

دمت بعز وعافية

**ا بو سليمان** · أكتوبر 26, 2014

أخى فى الله

الأستاذ الكريم // زمزم

اليكم بالمرفقات تجربة لعملية النسخ كل دقيقة

من الخلية B3 الى الخلية D3

اى محتوى بالخلية الأولى يتم نقله الى الخلية الثانية

فى حال كون الملف مفتوح فقط

وجرب بنفسك ( الملف اوفيس 2010 )

الى أن يقوم أحد الأساتذة بالتوصل كاملا لما تريد

وتقبل منى وافر الاحترام والتقدير

اخي محمود انت مبدع بارك الله فيك

هذه بدايه ان شاء الله لحل لمشكله

سوف ارفع ملف فيه البيانات المطلوب نقلها غدا ان شاء الله

وياحبذا يتم عمل النقاط التاليه

نقل يكون بعد انتهاء الساعة 4 عصرا

ان يكون النقل لمره واحد ه فقط باليوم الواحد

ان تتم عمليه التتابع لفتره لا تقل عن 40 يوما

انتظر ابد اعك بارك الله فيك

تم تعديل أكتوبر 26, 2014 بواسطه زمزم

محمد لطفى · أكتوبر 26, 2014

جميله جميله

Mando_Mam · أكتوبر 27, 2014

السلام عليكم

فعلا انا محتاج شي مثل هذا في عملى

نريد الابداع

**الـعيدروس** · أكتوبر 27, 2014

السلام عليكم

حسب مافهمت اخ زمزم

ان الخلايا التي تتلقى بيانات من مصدر خارجي

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

وبشرط مابين الساعه الرابعة عصرا فقط استخدمنا كود الاخ محمود الشريف

مع بعض الاضافات اليك الكود

غير المدى في اول الكود

Private Const FD = "yyyy/mm/dd"
Private Const FT = "hh:mm:ss"
' الخلايا التي تتلقى  قيمها من مصدر خارجي
Private Const Are As String = "$A$2:$A$500"
Dim Tim_t
Dim Dn As Range
Dim Tn As Range
Dim Tim
Private Sub Ali_Tim()
Set Tn = [XF1]
Set Dn = [XG1]

Tim_t = Now + TimeValue("00:00:05")
Application.OnTime Tim_t, "Trn_Dt", , True
Dx = IIf(Dn = "", Val(Date) - 1, Val(Dn))
      If Time > TimeValue("16:00") And Time < TimeValue("16:59") Then
        If Dn = "" Then
           Tim_Cod
           ElseIf Dn = Date And Hour(Tn) = Hour(Tim) Then
           
           ElseIf Not Dx = Val(Date) Then
           Tim_Cod
         End If
      End If
      
End Sub
Private Sub Tim_Cod()
  Dim Rng As Range
  Set Tn = [XF1]
  Set Dn = [XG1]

  '================================
  For Each Rng In Range(Are)
     If Rng > Empty Then
      With Rng
       Lc = Cells(.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Column
         Cells(.Row, Lc) = Rng
      End With
     End If
  Next
  '================================
  
  Dn = Format(Now, FD)
  Tn = Format(Time, FT)
  Set Rng = Nothing
  Set Dn = Nothing: Set Tn = Nothing
End Sub
Private Sub Trn_Dt()
    Calculate
    Ali_Tim
End Sub
Sub auto_open()
    Ali_Tim
End Sub
Sub auto_close()
    On Error Resume Next
    Application.OnTime Tim_t, "Trn_Dt", , False
End Sub

تم تعديل أكتوبر 27, 2014 بواسطه الـعيدروس

**محمود_الشريف** · أكتوبر 27, 2014

أخى فى الله

الأستاذ القدير // العيدروس

بارك الله فيكم وجزاكم الله خير الخير

وتقبل منى وافر الاحترام والتقدير

**وائل احمد المصري** · أكتوبر 27, 2014

السلام عليكم

حسب مافهمت اخ زمزم

ان الخلايا التي تتلقى بيانات من مصدر خارجي

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

وبشرط مابين الساعه الرابعة عصرا فقط استخدمنا كود الاخ محمود الشريف

مع بعض الاضافات اليك الكود

غير المدى في اول الكود

Private Const FD = "yyyy/mm/dd"
Private Const FT = "hh:mm:ss"
' الخلايا التي تتلقى  قيمها من مصدر خارجي
Private Const Are As String = "$A$2:$A$500"
Dim Tim_t
Dim Dn As Range
Dim Tn As Range
Dim Tim
Private Sub Ali_Tim()
Set Tn = [XF1]
Set Dn = [XG1]

Tim_t = Now + TimeValue("00:00:05")
Application.OnTime Tim_t, "Trn_Dt", , True
Dx = IIf(Dn = "", Val(Date) - 1, Val(Dn))
      If Time > TimeValue("16:00") And Time < TimeValue("16:59") Then
        If Dn = "" Then
           Tim_Cod
           ElseIf Dn = Date And Hour(Tn) = Hour(Tim) Then
           
           ElseIf Not Dx = Val(Date) Then
           Tim_Cod
         End If
      End If
      
End Sub
Private Sub Tim_Cod()
  Dim Rng As Range
  Set Tn = [XF1]
  Set Dn = [XG1]

  '================================
  For Each Rng In Range(Are)
     If Rng > Empty Then
      With Rng
       Lc = Cells(.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Column
         Cells(.Row, Lc) = Rng
      End With
     End If
  Next
  '================================
  
  Dn = Format(Now, FD)
  Tn = Format(Time, FT)
  Set Rng = Nothing
  Set Dn = Nothing: Set Tn = Nothing
End Sub
Private Sub Trn_Dt()
    Calculate
    Ali_Tim
End Sub
Sub auto_open()
    Ali_Tim
End Sub
Sub auto_close()
    On Error Resume Next
    Application.OnTime Tim_t, "Trn_Dt", , False
End Sub

عمل متميز بارك الله فيكما

**شوقي ربيع** · أكتوبر 27, 2014

السلام عليكم

هذا الملف يحوي على

شيت لداتا يكون مستقبل البيانات الخارجية في العمود الاول

12 شيت بأسماء اشهر السنة لكي ترحل اليها بيانات الداتا (العمود الاول من الداتا فقط)

الترحيل يكون حسب الشهر الحالي (حسب ساعة الجهاز) بحيث يقوم الكود بفحص الشيت المتوافق مع الشهر الحالي ثم يرحل بيانات الداتا الى اول عمود فارغ في ذالك الشيت مرة واحدة فقط في اليوم بعد الساعة الرابعة مساءا

عند انتهاء الشهر سيكون لديك اعمدة بعدد ايام ذالك الشهر ورأس كل عمود يكون عبارة عن تاريخ اليوم

الاكواد المستعملة

Option Explicit
Dim Sh As Worksheet, WrSh As Worksheet
'ÝÍÕ ÇáÔíÊ ÇáãÊæÇÝÞ ãÚ ÇáÔåÑ ÇáÍÇáí
Function NomFeuil(Mois As Byte) As String
  Set Sh = ThisWorkbook.Sheets("Data")
Dim r As Byte
    For r = 1 To 12
        Select Case Mois
        Case r
        NomFeuil = Sh.Range("B" & r): Exit Function
        End Select
     Next
End Function

'ÊÑÍíá ÚãæÏ ÇáÏÇÇ Çáì Çæá ÚãæÏÝÇÑÛ Ýí ÇáÔíÊ ÇáãÊæÇÝÞ ãÚ ÇáÔåÑ ÇáÍÇáí
Sub Envoi()
  Set Sh = ThisWorkbook.Sheets("Data")
  Set WrSh = ThisWorkbook.Sheets(NomFeuil(Month(Now)))

Dim Lrw     As Long: Lrw = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
Dim Lcm     As Long: Lcm = WrSh.Cells(1, 16384).End(xlToLeft).Column + 1
Dim i       As Integer
If WrSh.Range("A1") = "" Then Lcm = Lcm - 1
WrSh.Cells(1, Lcm) = Date
For i = 2 To Lrw
WrSh.Cells(i, Lcm) = Sh.Range("A" & i)
Next

End Sub
'ÇáÊÑÍíá ÍÓÈ ÇáæÞÊ
Sub Verification()
  Set WrSh = ThisWorkbook.Sheets(NomFeuil(Month(Now)))
Dim Lcm     As Long: Lcm = WrSh.Cells(1, 16384).End(xlToLeft).Column
If WrSh.Cells(1, Lcm) = Date Then Exit Sub
If Time > TimeValue("16:00") Then Envoi
End Sub

ارجو ان يكون المطلوب

تحياتي للجميع

Test.rar

**ا بو سليمان** · أكتوبر 28, 2014

بارك الله فيكم جميع ا

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

**ا بو سليمان** · أكتوبر 28, 2014

السلام عليكم احبتي الكرام

هذا ملف فيه المطلوب وارجو ان هذا الملف يعمل بالشكل الي ارغبه (( وكل امل ان شاء الله انه سوف يتم بسبب وجود اعلام وكوكبة من النجوم في الاكسل في اوفسينا ))

الملف بالمرفقات

يوجد به صفحة رئيسية وهي بلون الخليه الاساسيه بالاصفر وتحتوي على الواجهة الرئيسة وهي المصدر الا ساي للبيانات

فيه اوراق بمسيمات ( اخر - ادني - اعلى - فتح - قيمة - حجم ...) لكل مسمى صفحة مستقله وهي التي ارغب العمل عليه بشكل الي بحيث يتم نقل كل عمود الى العمود الذي يليه

zmzm اوفسينا.rar

تم تعديل أكتوبر 28, 2014 بواسطه زمزم

**أبوعيد** · أكتوبر 28, 2014

السلام عليكم

ادخل على صفحة (أعلى) واضغط زر تنفيذ ولاحظ ماذا يحدث

تحياتي

zmzm اوفسينا#1.rar

**شوقي ربيع** · أكتوبر 28, 2014

السلام عليكم

يتم الترحيل اوتوماتيكيا مرة واحدة في اليوم بعد الساعة الرابعة (حسب ساعة الجهاز لديك) ا

و ذألك لجميع الاوراق التي ذكرتها في طلبك الاخير الى العمود الذي يليه ثم الى الذي يلي الذي يله وهكذا كل يوم

ارجو ان يكون هو المطلوب

الاكواد المستعملة

Option Explicit
Dim Sh As Worksheet, WrSh As Worksheet

Sub Envoi()

Dim Nm As Byte
For Nm = 2 To 7
    Set WrSh = ThisWorkbook.Sheets(Nm)
    Dim Lrw     As Long: Lrw = WrSh.Cells(WrSh.Rows.Count, 1).End(xlUp).Row
    Dim Lcm     As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column + 1
    Dim i       As Integer
        If WrSh.Range("A1") = "" Then Lcm = Lcm - 1
        WrSh.Cells(1, Lcm) = Date
        For i = 2 To Lrw
        WrSh.Cells(i, Lcm).Value = WrSh.Range("C" & i).Value
        Next
Next

End Sub

Sub Verification()
Dim Nm As Byte
For Nm = 2 To 7
    Set WrSh = ThisWorkbook.Sheets(Nm)
    Dim Lcm     As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column
If WrSh.Cells(1, Lcm) = Date Then Exit Sub
Next
If Time > TimeValue("16:00") Then Envoi
End Sub

تحياتي للجميع

zmzm اوفسينا.rar

**ا بو سليمان** · أكتوبر 29, 2014

السلام عليكم

ادخل على صفحة (أعلى) واضغط زر تنفيذ ولاحظ ماذا يحدث

تحياتي

رحم الله و الديك واسعد بالدنيا و الاخره

ممتاز بارك الله فيك

وسوف ااطلب اضافات اخرى على الملف لاحقا ان شاء الله

**ا بو سليمان** · أكتوبر 29, 2014

السلام عليكم

يتم الترحيل اوتوماتيكيا مرة واحدة في اليوم بعد الساعة الرابعة (حسب ساعة الجهاز لديك) ا

و ذألك لجميع الاوراق التي ذكرتها في طلبك الاخير الى العمود الذي يليه ثم الى الذي يلي الذي يله وهكذا كل يوم

ارجو ان يكون هو المطلوب

الاكواد المستعملة
Option Explicit
Dim Sh As Worksheet, WrSh As Worksheet

Sub Envoi()

Dim Nm As Byte
For Nm = 2 To 7
    Set WrSh = ThisWorkbook.Sheets(Nm)
    Dim Lrw     As Long: Lrw = WrSh.Cells(WrSh.Rows.Count, 1).End(xlUp).Row
    Dim Lcm     As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column + 1
    Dim i       As Integer
        If WrSh.Range("A1") = "" Then Lcm = Lcm - 1
        WrSh.Cells(1, Lcm) = Date
        For i = 2 To Lrw
        WrSh.Cells(i, Lcm).Value = WrSh.Range("C" & i).Value
        Next
Next

End Sub

Sub Verification()
Dim Nm As Byte
For Nm = 2 To 7
    Set WrSh = ThisWorkbook.Sheets(Nm)
    Dim Lcm     As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column
If WrSh.Cells(1, Lcm) = Date Then Exit Sub
Next
If Time > TimeValue("16:00") Then Envoi
End Sub
تحياتي للجميع

نسال الله العظيم ان يسعدك في الدنيا و الاخره

رائع ومميز اخي الفاضل

ولا نستغني عن المساعدة في طلب اضافات اخرى على الملف

شكرا لك بارك الله فيك

**ا بو سليمان** · أكتوبر 30, 2014

السلام عليكم

فيه مشكله في النقل من عمود الى عمود اخر

لانني انتظر التطبيق الفعلي ولكن للاسف يتم النقل الى العمود المجاور ثم لا ينتقل الى ما بعدة في الايام الاخري

**ا بو سليمان** · أكتوبر 31, 2014

السلام عليكم

يوجد بالمرفقات ملف مربوط بشكل مباشر على صفحة تداول وهو يتحدث بشكل يومي

=======

احبتي الكرام مطلوب نقاط مهمة في التنسيق مثلا

عندما نختار مثلا خانة ( اعلى )

يوجد في صفحة ( اعلى )

اسم الشركة ثم عمود ( اعلى ) ثم عمود ( اعلى 1 ) ثم ( اعلى 2 ) ثم ( اعلى 3 ) وهكذا

المطلوب هو

ان يتم نقل قيمة العمود ( اعلى ) الى ( اعلى 1 ) في اليوم الاول

ان يتم نقل قيمة العمود ( اعلى ) الى ( اعلى 1 ) و قيمة ( اعلى 1 ) الى العمود ( اعلى 2 ) في اليوم الثاني

ان يتم نقل قيمة العمود ( اعلى ) الى ( اعلى 1 ) و قيمة ( اعلى 1 ) الى العمود ( اعلى 2 ) وقيمة العمود( اعلى 2) الى العمود ( اعلى 3 ) في اليوم الثالث ...وهكذا يتكرر حتى اخر خانة

وهكذا بقية الاعمدة للصفحات الاخرى

على ان يتم تحديث بعد نهاية الساعة 3.مساء بتوقيت المملكة ( الواحدة والنصف بتوقيت جرينتش)

وان يقبل التحديث مره واحده في اليوم فقط ( للأعمدة التي بها ايم العمود ومعه رقم مثل ( اعلى 1 - اعلى 2 - اعلى 3 ) اما العمود

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

ملاحظة .. اعلى = اليوم

اعلى 1 = اعلى سابق ( امس ) يوم واحد سابق

اعلى 2= اعلى سابق ( قبل امس ) يومين سابقات

اعلى 3= اعلى سابق( قبل قبل امس ) ثلاثة ايام سابقة

وهكذا

بالنهاية مع مرور الايام سوف احصل على

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

==========

تداول على االاكسل اوفسينا.rar

تم تعديل أكتوبر 31, 2014 بواسطه زمزم

**ا بو سليمان** · أكتوبر 31, 2014

الاخوة الكرام

محمود_الشريف

أبوعيد

الـعيدروس

شوقي ربيع

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

انا شاكرا لكم حسن تجاوبكم وحسن ابداعكم

اخيكم

زمزم

**شوقي ربيع** · أكتوبر 31, 2014

السلام عليكم

الملف الذي ارفقته لك في المشاركة رقم 14 يقوم تماما بما طلبته

الا انه يعتمد على تاريخ اليوم في رؤوس الاعمدة بدل اعلى1 و اعلى2 ......

وذلك لنتمكن من معرفة هل تم الترحيل في ذلك اليوم ام لا

تاكد من الملف وان كان مثل ما تريد سأقوم بنقل الاكواد الى الملف الاخير الخاص بك

**ا بو سليمان** · أكتوبر 31, 2014

الملف الذي كتبتة في المشاركة رقم 18 يختلف في مصدر البيانات

اما ما ذكرته فهو تمام نفس المطلوب ولكن الاختلاف في الترحيل من العمود الاصل ا الى العمود 1 ثم من الغد النقل من العمود الاصل الى العمود 1 ونقل بيانات العمود 1 الى العمود 2 وهكذا

**شوقي ربيع** · أكتوبر 31, 2014

السلام عليكم

تم عمل المطلوب بالمرفق ادناه

مع مراعات ان رؤوس الاعمدة تكون عبارة عن تواريخ بدل مما ذكرة اعلى1, اعلى2 ......

وذلك لكي يتعرف الكود هل تم الترحيل في ذلك اليوم ام لا

كما لاحظة انه يمكن لكود الترحيل ان يسبق استقبال بالبيانات من المصدر الخارجي في حالت فتح الملف بعد الساعة الثلاثة مساءا

لذى تم اضافة كود عند اقلاع الملف يأخر عملية الترحيل 30 ثانية لإعطاء الملف فرصة في جلب البيانات من المصدر الخارجي

ان لم تكن المدة كافية فما عليك سوى زيادة مدة التأخير في هذا الكود

Private Sub Workbook_Open()
   Application.OnTime Now + TimeValue("00:00:30"), "Verification"
End Sub

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

Option Explicit
Dim Sh As Worksheet, WrSh As Worksheet

Sub Envoi()

Dim Nm As Byte
For Nm = 3 To 8
  Set WrSh = ThisWorkbook.Sheets(Nm)
  WrSh.Select
  If WrSh.Range("D1") <> "" Then
  WrSh.Range(Columns(3), Columns(3).End(xlToRight)).Cut Destination:=Range("D1")
  Else
    WrSh.Columns(3).Cut Destination:=Range("D1")
  End If
WrSh.Columns(2).Copy
WrSh.Range("C1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
WrSh.Range("C1") = Date
Next

End Sub

Sub Verification()
Dim Nm As Byte
For Nm = 2 To 7
    Set WrSh = ThisWorkbook.Sheets(Nm)
     If WrSh.Range("C1") = Date Then Exit Sub
If Time > TimeValue("15:00") Then Envoi
Next
End Sub

ايضا يمكنك التعديل في الوقت الذي ان يتم الترحيل فيه من هذا الكود

تحياتي للجميع

تداول على االاكسل اوفسينا.rar

**ا بو سليمان** · نوفمبر 1, 2014

احسن الله اليك اخي الكريم شوقي ربيع

سوف افتح البرنامج وانظر اليه

محمد لطفى · نوفمبر 1, 2014

السلام عليكم

بصراحه الشغل عالى جداجدا

بس فى بعض الاشياء لا تفتح انا عندى اوفيس 2013

تم تعديل نوفمبر 1, 2014 بواسطه محمد لطفى

**شوقي ربيع** · نوفمبر 1, 2014

السلام عليكم

بصراحه الشغل عالى جداجدا

بس فى بعض الاشياء لا تفتح انا عندى اوفيس 2013

السلام عليكم

لم افهم الاشاء التي لا تفتح عندك

كما ان الملف مربوط ببرنامج خارجي اضن اه مستشار او ماشابه يجب ان يكون مثبت لديك على الجهاز لكي تضهر عند النتائج

تحياتي

تسجيل الدخول

هل توقف الابداع عند هذا الحدّ .. ام لا يزال هنالك امل يلوح بالافق ..

الردود الموصى بها

ا بو سليمان

محمود_الشريف

أبوعيد

ا بو سليمان

محمد لطفى

Mando_Mam

الـعيدروس

محمود_الشريف

وائل احمد المصري

شوقي ربيع

ا بو سليمان

ا بو سليمان

أبوعيد

شوقي ربيع

ا بو سليمان

ا بو سليمان

ا بو سليمان

ا بو سليمان

ا بو سليمان

شوقي ربيع

ا بو سليمان

شوقي ربيع

ا بو سليمان

محمد لطفى

شوقي ربيع

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information