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 i = 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(Commands, CompilerMessage)
If CompilerError <> 0 Then
MsgBox CompilerMessage
End If
'End code
'------------------------------------------
Exit Sub
ErrorRoutine:
MsgBox Err.Description & " Please contact your system administrator", vbCritical
|