عرض مشاركة واحدة
قديم 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 غير متواجد حالياً   رد مع اقتباس