مساعدة ضروري

[ابو ذكري]

ارجو المساعدة في تفعيل الساعة في الدالة now لتتفاعل بالثواني مع ساعة الويندز

ورجاء كتابة معادله تعطي المعنى

انه في حالة وصول الساعة 10:30 ص يقوم اكسل بفتح الارتباط الموجود في الخلية a1

وتقبلوا مروري

[nofal.saad]

ارجو المساعدة في تفعيل الساعة في الدالة now لتتفاعل بالثواني مع ساعة الويندز

ورجاء كتابة معادله تعطي المعنى

انه في حالة وصول الساعة 10:30 ص يقوم اكسل بفتح الارتباط الموجود في الخلية a1

وتقبلوا مروري

اخي الكريم :

بالنسبة لتفعيل الثواني , يجب عليك تغيير تنسيق الخلية الىdd/mm/yyyy hh:mm:ss .

ام بالنسبة الى معادلة الارتباط فيمكنك ان تبرمج الـ Windows بعمل ذلك عن طريق برنامج Scheduled Tasks و الموجود ضمن ادوات النظام ضمن البرامج الملحقة.

[طارق محمود]

السلام عليكم

بالإضافة إلي رد أخي نوفل nofal.saad

أيضا يمكن عمل ذلك من الإكسل

ولكنها غير مريحة من وجهة نظري

علي كل حال الكود منقول من أعمال أحد العباقرة بالمنتدي

أظنه عالمنا الكبير خبور خير

تفضل المرفق

تنفيذ الأمر عند وقت محدد.rar

[ابو ذكري]

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

ومع نسخها لا تعمل في الشيت الذي اعمل عليه

كما اتمنى تعديل الكود ليقوم بفتح موقع البنك المركزي اسعار العملات ( ) بدلا من جمع الخلايا

Sub auto_open()

RunClock

End Sub

Public Sub RunClock()

Application.OnTime Now + TimeSerial(0, 0, 1), "RunClock"

ThisWorkbook.Names.Add "blink", "=" & On_Off

If ([i8].Value) * 86400 < 1 Then Range("A1").FormulaR1C1 = "=SUM(R[1]C:R[33]C)"

End Sub

وتقبلوا تحياتي

تم تعديل يوليو 22, 2010 بواسطه abuzekri

[أبوســـارة1973]

رائع أخي طارق

[طارق محمود]

رائع أخي طارق

أخي أبوسارة

جزاك الله خيرا

أنت الأروع وألأسبق

[طارق محمود]

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

ومع نسخها لا تعمل في الشيت الذي اعمل عليه

كما اتمنى تعديل الكود ليقوم بفتح موقع البنك المركزي اسعار العملات ( ) بدلا من جمع الخلايا

Sub auto_open()

RunClock

End Sub

Public Sub RunClock()

Application.OnTime Now + TimeSerial(0, 0, 1), "RunClock"

ThisWorkbook.Names.Add "blink", "=" & On_Off

If ([i8].Value) * 86400 < 1 Then Range("A1").FormulaR1C1 = "=SUM(R[1]C:R[33]C)"

End Sub

وتقبلوا تحياتي

أخي العزيز

إستبدل آخر سطر في الكود قبل النهاية اللي كان

If ([i8].Value) * 86400 < 1 Then Range("A1").FormulaR1C1 = "=SUM(R[1]C:R[33]C)"

الي

If ([i8].Value) * 86400 < 1 Then 


Sheets("Sheet2").Select

	With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.cbe.org.eg", _

 	Destination:=Range("A1"))

 	.Name = "www.cbe.org.eg"

 	.FieldNames = True

 	.RowNumbers = False

 	.FillAdjacentFormulas = False

 	.PreserveFormatting = True

 	.RefreshOnFileOpen = False

 	.BackgroundQuery = True

 	.RefreshStyle = xlInsertDeleteCells

 	.SavePassword = False

 	.SaveData = True

 	.AdjustColumnWidth = True

 	.RefreshPeriod = 0

 	.WebSelectionType = xlSpecifiedTables

 	.WebFormatting = xlWebFormattingNone

 	.WebTables = """table10"""

 	.WebPreFormattedTextToColumns = True

 	.WebConsecutiveDelimitersAsOne = True

 	.WebSingleBlockTextImport = False

 	.WebDisableDateRecognition = False

 	.WebDisableRedirections = False

 	.Refresh BackgroundQuery:=False

	End With

End IF

أنا لم أجربه بس إن شاء الله يشتغل

[ياسر خليل أبو البراء]

الأخ الحبيب

جرب هذه الملف

أخوك أبو البراء

RunMacroAtCertainTime.rar

[طارق محمود]

السلام عليكم

رائع أبو البراء

جزاك الله خيرا

مع إمكانية تبديل الكود

Sub LaunchSite()

Dim newsite As Object

Set newsite = CreateObject("InternetExplorer.application")

newsite.Visible = True

newsite.Navigate "http://www.cbe.org.eg"

End Sub

بالكود

Sub LaunchSite()

Sheets("Sheet1").Select

	With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.cbe.org.eg", Destination:=Range("A1"))

 	.Name = "www.cbe.org.eg"

 	.FieldNames = True

 	.RowNumbers = False

 	.FillAdjacentFormulas = False

 	.PreserveFormatting = True

 	.RefreshOnFileOpen = False

 	.BackgroundQuery = True

 	.RefreshStyle = xlInsertDeleteCells

 	.SavePassword = False

 	.SaveData = True

 	.AdjustColumnWidth = True

 	.RefreshPeriod = 0

 	.WebSelectionType = xlSpecifiedTables

 	.WebFormatting = xlWebFormattingNone

 	.WebTables = """table10"""

 	.WebPreFormattedTextToColumns = True

 	.WebConsecutiveDelimitersAsOne = True

 	.WebSingleBlockTextImport = False

 	.WebDisableDateRecognition = False

 	.WebDisableRedirections = False

 	.Refresh BackgroundQuery:=False

	End With


End Sub

وتعديل الكود الذي في حدث ThisWorkbook إلي

Private Sub Workbook_Open()

x = InputBox("what time you want to open 	HH:MM ?")

Application.OnTime TimeValue(x), "LaunchSite"

End Sub

ليكون كما يريد الأخ السائل

فيسئل الكود أولا عن الموعد المطلوب للعمل ثم يتم المطلوب في الوقت المحدد

مرفق الملف مرة كمان

ولكن كل دي تحابيش

أصل الكود اللي إنت عملته رااائع

RunMacroAtCertainTime1.rar

تم تعديل يوليو 22, 2010 بواسطه TareQ M

[ياسر خليل أبو البراء]

باشمهندس طارق

جزاكم الله خيراً على كلماتك الرائعة وتشجيعك المستمر لنا

تحابيش رائعة وجميلة ، تسلم أياديك يا أبازياد