طلب كود ادراج صورة من الماسح الضوئي

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

 

اساتذتي الأفاضل و اخواني الكرام

 

 

حيث انني محتاج لكود يقوم بادراج الصورة من الماسح الضوئي مباشرة الى ورقة اكسل

اتمنى من يوجد لديه الكود ان يساعدني به

 

جزاكم الله كل خير سلفا

 

[شوقي ربيع]

السلام عليكم 

استاذ احمد زمان

لا اعتقد ان هناك كود يقوم بأمر مماثل لطلبك

لكن يمكنك التحايل وجلب الصور

اي  :

-  ان تخصص مكان لتخزين الصور الناتجة عن الماسح الضوئي 

-  في الاكسل تضع كود جلب الصور  من  مسار الملف  الذي اخترته 

وهدا مجرد راي مني  استاذي الفاضل 

ســـــــــــــــــــلام 

تم تعديل أبريل 19, 2013 بواسطه دغيدى

[خالد الشاعر]

استاذ احمد

 

وجدت هذا الكود جربة

Sub scanner()
CommandBars.FindControl(ID:=1764).Execute
End Sub

تم تعديل أبريل 23, 2013 بواسطه طارق محمود

[احمدزمان]

السلام عليكم 

استاذ احمد زمان

لا اعتقد ان هناك كود يقوم بأمر مماثل لطلبك

لكن يمكنك التحايل وجلب الصور

اي  :

-  ان تخصص مكان لتخزين الصور الناتجة عن الماسح الضوئي 

-  في الاكسل تضع كود جلب الصور  من  مسار الملف  الذي اخترته 

وهدا مجرد راي مني  استاذي الفاضل 

ســـــــــــــــــــلام 

 

وعليكم السلام و رحمة الله وبركاته

 

اخي شوقي (كلك حركات)

اشكرك جزيل الشكر على ملاحظتك ومرورك الكريم الذي لم تبخل فيه برأيك

في الرابط التالي

http://www.officena.net/ib/index.php?showtopic=44394

 

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

و الموضوع كان طلب لأخونا ابو تميم

 

ولكن كنت اتمنى ادراج الصورة في نفس ورقة اكسل

 

تحياتي وتقديري لك و جزاك الله كل خير

[احمدزمان]

استاذ احمد

 

وجدت هذا الكود جربة

 

Sub scanner()

CommandBars.FindControl(ID:=1764).Execute

End Sub

السلام عليكم

 

الأستاذ الفاضل و الأخ الكريم khhanna

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

كود رائع جدا بارك الله فيك

 

عندما قرأته للوهلة الأولى توقعت انه لن يعمل في اكسل 2007 بسبب عدم وجود زر امر في 2007 لإدراج صورة من الإسكنر

ولكن عندما جربته

فعلا فتح لي شاشة حوار الإسكنر لإدراج الصورة

رائع جدا جزاك الله كل خير

 

واتمنى ان يتفضل علينا احد الإخوه

بكود يدرج الصورة في ورقة الإكسل مباشرة من الإسكنر . . . دون التوقف عند خطوات شاشة حوار الإسكنر

 

خالص تحياتي وتقديري

[شوقي ربيع]

السلام عليكم 

استاذي الفاضل احمد زمان 

اولا أتأسف لعدم تلبة طلبك كما تريد 

ثنيا اتا أعتذر لعدم اشارتي لمشاركة الأستاذ الفاضل ابونصار في شرحي السابق لئني بصدق لم اكن اعلم بها

وماذكرته لك مجرد فكرة خطرت في بالي تلك اللحضة

مع تحياتي وتقديري لك استاذي الفاضل احمد زمان 

تم تعديل أبريل 19, 2013 بواسطه شوقي ربيع

[احمدزمان]

السلام عليكم 

 

وماذكرته لك مجرد فكرة خطرت في بالي تلك اللحضة

 

 

وعليكم السلام ورحمة الله

فكرة رائعة من اخ اروع

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

 

 

[الـعيدروس]

السلام عليكم

استاذي الحبيب احمد زمان

عند مراجعتي للمواضيع المشارك فيها

اطلعت على ردك 

أعذرني على التأخير لاني من فترة لم ادخل المنتدى الغالي

هذه محاولة ارجو ان تفي بالغرض

 

الية الكود كالتالي :

يجلب الصورة من الاسكنار لنفس فولدر ملف الاكسل

بتسلسل ارقام لمسمى معين

ويرفقها  الى ورقة الاكسل 

ارجو التجريه 

وكل وعام وانت بألف صحه وعافيه

 

Scn.rar

[الـعيدروس]

تعديل بسيط على الكود

 

 

Scn_1.rar

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

 

اخونا الحبيب المبدع ابونصار

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

دائما تاعبينك معانا

 

جربت الملف على 2003 لم يعمل

 

'Dim W_A As New WIA.ImageFile
'Dim WD_A As New WIA.CommonDialog
'Dim WS_A As WIA.Device
 

هذه التعريفات كلها توقفت

 

ولكن لاحقا سوف اجربة على 2007

 

اشكرك جزيل الشكر على اهتمامك

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

[الـعيدروس]

وعليكم السلام ورحمة الله وبركاته

استاذي الحبيب احمد زمان

لااعلم ان كنت فعلت المرجع من قائمة References

اذا لم يفعل ضيف هذه السطرين اول كود Imp_Scan

لتفعيل مرجع اداة WIA 

On Error GoTo nxt
   Set Ref_Ad = ThisWorkbook.VBProject
   Ref_Ad.References.AddFromFile "C:\Windows\system32\wiaaut.dll"
nxt:

انا اعمل حاليا على اوفيس 2007 والكود شغال معي

 

وهذا الكود وبه الاضافه السابقة

Private Sub Imp_Scan()
   On Error GoTo nxt
   Set Ref_Ad = ThisWorkbook.VBProject
   Ref_Ad.References.AddFromFile "C:\Windows\system32\wiaaut.dll"
nxt:
Dim W_A As New WIA.ImageFile
Dim WD_A As New WIA.CommonDialog
Dim WS_A As WIA.Device
On Error GoTo Er_a
Set WS_A = WD_A.ShowSelectDevice
Dim Path_F$
Dim Ar As Variant
Dim i, n, A_M
Dim x(100) As Integer
Dim Ar_Max&
Dim Start%, Last%, Num%
On Error Resume Next
Path_F = ThisWorkbook.Path & Application.PathSeparator
'Path_F = "C:\" & "Ali"
    M_v = Ali_List(Path_F)
If TypeName(M_v) <> "Boolean" Then
   For i = LBound(M_v) To UBound(M_v)
      M_v(i) = Ali_Re(M_v(i))
   Next
  Start = LBound(M_v): Last = UBound(M_v)
   Num = Last - Start + 1
  For i = Start To Last
     x(i) = M_v(i)
  Next i
   Ar_Max = x(Start)
  For n = Start + 1 To Last
     If x(n) > Ar_Max Then Ar_Max = x(n)
  Next n
Else
End If
If Ali_List(Path_F) = False Then A_M = 1
With WS_A.Items(1)
  .Properties("6146").Value = 4
    .Properties("6147").Value = 100
     .Properties("6148").Value = 100
       .Properties("6149").Value = 0
     .Properties("6150").Value = 0
    .Properties("6151").Value = 830
  .Properties("6152").Value = 1167
   Set W_A = .Transfer(wiaFormatJPEG)
End With
'*************************************************************
If Ar_Max = 0 Then
Ar_Max = 1
Else
A_M = Ar_Max + 1
End If
If Dir(ThisWorkbook.Path & "\A_M.jpg") <> "" Then
  Kill ThisWorkbook.Path & "\A_M.jpg"
End If
''**************************************************************
W_A.SaveFile (Path_F & "\" & A_M & "A_M.jpg")
Erase x
MsgBox "تم قراءة الصوره من الاسكنر بنجاح", vbInformation, ""
Set W_A = Nothing
Set WS_A = Nothing
Exit Sub
Er_a:
MsgBox ("تأكد من توصيل الماسح الضوئي"), , "تنبية !!!"
End Sub

ارجو التجربه

وان شاء الله يعمل معك

[شعراوي ربيع]

بارك الله فيك اخي الكريم 

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

بسم الله ما شاء الله عليك يا أبو نصار

موضوع مميز ومتميز .. رغم وجودي في المنتدى لفترات طويلة لكني لم أرى الموضوع من قبل

يبدو أننا بحاجة إلى حملة تفتيش عن الكنوز للاستفادة منها

تقبل تحياتي