مشكله بكود السكنر ممكن المساعد لانه لا يعمل الا على WINDOWS 8/10 فقط الاقدم

[محمد إبراهيم محمد]

السلام عليكم

 

لقية موضوع لكن المشكله للاكسس وارغب بكود لاخذ صوره بالاكسل

 

 

Private Const iScanner As Long = 1764
Dim iSh
Private Sub Cmd_Pic_Folder_Click()
May_Pic = Application.GetOpenFilename("Picture Files (*.jpg; *.jpeg; *.bmp; *.gif),*.jpg; *.jpeg; *.bmp; *.gif")
    If May_Pic = False Then Exit Sub
On Error GoTo 1
    Set Image1.Picture = LoadPicture(May_Pic)
Exit Sub
1
MsgBox "هذا النوع من الصور غير معتمد في البرنامج", vbExclamation + vbMsgBoxRight, " "
End Sub

Private Sub CmdSA_Click()
On Error GoTo 1
  Set s = iSh.Shapes(CStr(Me.Text_PicTo_Copy))
  s.CopyPicture
  iSh.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  iSh.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  iSh.Shapes(iSh.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
1
Dim N_Pic As String
If TBN_Pic.Text = "" Then Exit Sub
N_Pic = ThisWorkbook.Path & "\SW\S\" & TBN_Pic & ".jpg" 'bmp
SavePicture Image1.Picture, N_Pic
UserForm1.LabelPic.Caption = N_Pic
Application.Visible = False
Unload Me
End Sub

Private Sub CmdWA_Click()
On Error GoTo 1
  Set s = iSh.Shapes(CStr(Me.Text_PicTo_Copy))
  s.CopyPicture
  iSh.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  iSh.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  iSh.Shapes(iSh.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
1
Dim N_Pic As String
If TBN_Pic.Text = "" Then Exit Sub
N_Pic = ThisWorkbook.Path & "\SW\W\" & TBN_Pic & ".jpg" 'bmp
SavePicture Image1.Picture, N_Pic
UserForm1.LabelPic.Caption = N_Pic
Application.Visible = False
Unload Me
End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Set iSh = Sheets("PH")
iSh.Activate
Application.CommandBars.FindControl(ID:=1764).Execute
  For Each s In iSh.Shapes
  Me.Text_PicTo_Copy.Text = s.Name
  Next
Application.Visible = False
End Sub

Private Sub sCancel_Click()
Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

ارغب بالمساعده في التعديل

وشكرا لكم