مدونة منذر اسامة

العودة   منتديات جريت بلينز العربية Great Plains For Arab > الأقــســـام الــعـــامــة > منتدى جريت بلينز العام

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

إضافة رد
 
أدوات الموضوع انواع عرض الموضوع
قديم 25-Nov-2014, 08:50 AM   #1
saed_adnan
عضو جديد
 
تاريخ التسجيل: May 2009
الدولة: الامارات العربية المتحدة - ابو ظبي
المشاركات: 19
من مواضيعي  
افتراضي تنفيذ الماكرو من داخل الفيجوال بيسك

[IMG]C:\ItemSerialNumberEntry.bmp[/IMG]السلام عليكم و رحمه الله و بركاته

قرأت في المنتدى عن اسئلة حول الطريقة لتنفيذ الماكرو من داخل الفيجوال بيسك VBA

اليكم الطريقة و ارجو ان نستفيد منها جميعا

مثال , من موديول Inventory , عند استلام 100 قطعة من المادة A و كل قطعة لها رقم تسلسلي Serial Number
و تريد ادخال هذه الارقام و تسندها الى المادة
من الصعب ان تقوم بهذه العملية بشكل يدوي , حيث انك تحتاج الى وقت طويل , لذا نحتاج الى طريقة سريعة و هي استخدام الماكرو

اولا:
قم تعديل شاشة Item Serial Number Entry و ذلك باضافة زر جديد button و ذلك لكتابة الكود داخله
ثانيا:
احفظ الارقام التسلسلية في Text :
C:\Serial Number Upload\Serial Number.txt


طريقة عمل الكود:

اولا: قراءة الملف و معرفة كم هو عدد هذه الارقام الموجوده في داخله و لنفرض انها 100
ثانيا: تخزين هذه الارقام التسلسلية داخل Array
ثالثا: انشاء ماكرو لادخال البيانات المطلوبة
رابعا: تنفيذ الماكرو


كود PHP:
On Error GoTo ErrorRoutine


    
'MsgBox "Please wait until the completion of data loading", vbInformation

    '
Read serials from text file
    
'------------------------------------------'
    
Dim sFileName As String
    Dim iFileNum 
As Integer
    Dim sBuf 
As String
    Dim Counter 
As Integer
    Counter 
0
    sFileName 
"C:\Serial Number Upload\Serial Number.txt"
    ' does the file exist?  simpleminded test:
    If Len(Dir$(sFileName)) = 0 Then
         MsgBox "Text file does not exist :" & vbNewLine & "C:\Serial Number Upload\Serial Number.txt", vbExclamation
        Exit Sub
    End If
    iFileNum = FreeFile()
    Open sFileName For Input As iFileNum
    Dim Arr(1 To 36500) As String
    Do While Not EOF(iFileNum)
        Line Input #iFileNum, sBuf
        Counter = Counter + 1
        Arr(Counter) = sBuf
    Loop
    Close iFileNum
    '
End code
    
'------------------------------------------'
    '
    '
Create dynamics macro
    
'------------------------------------------'
    
Dim i As Integer
    i 
1
    Open 
"C:\Serial Number Upload\SerialNumber.mac" For Output As #1
    
    
Dim record As String
    
For 1 To Counter
        record 
"# DEXVERSION=10.0.324.0 2 2"
        
Print #1, record
        
record "CheckActiveWin dictionary 'default'  form 'IV_Transaction_Entry' window 'IV_Transaction_Serial_Numbers' "
        
Print #1, record
        
record "  MoveTo field 'Serial Number' "
        
Print #1, record
        
record "  TypeTo field 'Serial Number' ," Arr(i)
        Print 
#1, record
        
record "  MoveTo field 'Insert Button' "
        
Print #1, record
        
record "  ClickHit field 'Insert Button' "
        
Print #1, record
    
Next
    Close 
#1
    
'End code
    '
------------------------------------------'
    '
    'Run macro
    '
------------------------------------------'
    Dim CompilerApp As New Dynamics.Application
    Dim CompilerMessage As String
    Dim CompilerError As Integer
    Dim Commands As String
    Commands = ""
    Commands = Commands & "local integer l_file_id; " & vbCrLf
    Commands = Commands & "local string pathname; " & vbCrLf
    '
Commands Commands "pathname = Path_GetForApp(1) + ""TEMP.MAC""; " vbCrLf
    Commands 
Commands "pathname = ""C:\Serial Number Upload\SerialNumber.mac""; " vbCrLf
    Commands 
Commands "TextFile_Close(l_file_id); " vbCrLf
    Commands 
Commands "if File_Probe(pathname) then " vbCrLf
    Commands 
Commands " run macro pathname; " vbCrLf
    Commands 
Commands "end if; " vbCrLf
    CompilerError 
CompilerApp.ExecuteSanscript(CommandsCompilerMessage)
    If 
CompilerError <> 0 Then
        MsgBox CompilerMessage
    End 
If
    
'End code
    '
------------------------------------------
    
    Exit 
Sub
        
ErrorRoutine
:
    
    
MsgBox Err.Description " Please contact your system administrator"vbCritical 
الصور المصغرة للصور المرفقة
اضغط على الصورة لعرض أكبر الاســـم:	ItemSerialNumberEntry.jpg‏ المشاهدات:	686 الحجـــم:	19.7 كيلوبايت الرقم:	801  

آخر تعديل بواسطة saed_adnan ، 25-Nov-2010 الساعة 09:43 AM. سبب آخر: اضافة صورة
saed_adnan غير متواجد حالياً   رد مع اقتباس
قديم 27-Nov-2014, 06:13 AM   #2
Monzer Osama
مدير عام منتديات جريت بلينز العربية
افتراضي

شكرا أخي سعيد, مشاركة متميزة
__________________
Monzer Osama
Saudia Arabia - Jeddah
00966501826235
Microsoft Certified Business Management Solutions Professional
Microsoft Certified Trainer
Monzer Osama غير متواجد حالياً   رد مع اقتباس
إضافة رد

الكلمات الدلالية (Tags)
ماكرو, macro


يتصفح الموضوع حالياً : 1 (0 عضو و 1 ضيف)
 
أدوات الموضوع
انواع عرض الموضوع

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

BB code متاحة
كود [IMG] متاحة
كود HTML معطلة

الانتقال السريع

المواضيع المتشابهه
الموضوع كاتب الموضوع المنتدى مشاركات آخر مشاركة
تنفيذ تقنيات نظم Erp لتحقيق العائد على الاستثمار بنجاح ahai منتدى جريت بلينز العام 8 09-Aug-2014 10:14 AM
استخدام الماكرو في ويندوز Monzer Osama مواضيع المطورين الأخرى 2 22-Dec-2012 08:46 PM
مطلوب كود لتغير Language Bar في الفيجوال بيسك Raad Al-Mrayatee منتدى أكواد فيجوال بيسك VBA 1 11-May-2012 07:20 AM
تنفيذ الماكرو من الفيجوال بيسك kh_waleed23 منتدى أكواد فيجوال بيسك VBA 7 25-Nov-2011 08:48 AM
أجابة على سؤالي(نفيذ الماكرو من الفيجوال بيسك ). kh_waleed23 منتدى أكواد فيجوال بيسك VBA 2 24-Nov-2011 08:50 AM


جميع الأوقات بتوقيت GMT +3. الساعة الآن 07:26 PM.


Powered by vBulletin® Version 3.8.3

الموقع والمنتدى من تطوير » شركة المنذر للاستضافة والتصميم

Copyright © 2000-2010 Jelsoft Enterprises Limited.
الموقع لا يمثل أي جهة رسمية بل هو جهد شخصي يرمي الى تجميع القدرات في برنامج جريت بلينز