منتديات جريت بلينز العربية Great Plains For Arab

منتديات جريت بلينز العربية Great Plains For Arab (http://www.gp4arab.com/forum/index.php)
-   منتدى جريت بلينز العام (http://www.gp4arab.com/forum/forumdisplay.php?f=31)
-   -   تنفيذ الماكرو من داخل الفيجوال بيسك (http://www.gp4arab.com/forum/showthread.php?t=2327)

saed_adnan 25-Nov-2014 08:50 AM

تنفيذ الماكرو من داخل الفيجوال بيسك
 
1 مرفق
[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 


Monzer Osama 27-Nov-2014 06:13 AM

شكرا أخي سعيد, مشاركة متميزة


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

Powered by vBulletin® Version 3.8.3

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


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