kamera ile mesaiye girme

[Murat OSMA]

Çünkü; resmi sayfaya ekledikten sonra Kill evnresim satırıyla resmi siliyoruz.

Bunun anlamı: Kill evnresim satırı ile resmi siliriyoruz......
Eğer koddaki Kill evnresim satırını silerseniz resmi silmemiş/sildirmemiş olursunuz.............

Anlatabildim mi ?

 

[esad45]

dosya üzerinde yapabilirmisiniz yapamadım ben

 

[numan şamil]

Merhaba Esad Bey,

Mevcut kodları aşağıda görebilirsiniz. Dosyanızı da ekliyorum.

Not: Kodlar Sn. Tarkan VURAL'a aittir. Dosyanıza göre uyarlanmıştır.

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
                            ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
                            ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
                            ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
                            (ByVal lpszWindowName As String, ByVal dwStyle As Long, _
                            ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
                            ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long
Rem Www.ExcelVBA.Net - Tarkan VURAL - 20-06-2012
Const CAP As Long = &H400
Const CAP_DRIVER_CONNECT As Long = CAP + 10
Const CAP_DRIVER_DISCONNECT As Long = CAP + 11
Const CAP_EDIT_COPY As Long = CAP + 30
Const CAP_SET_PREVIEW As Long = CAP + 50
Const CAP_SET_PREVIEWRATE As Long = CAP + 52
Const CAP_SET_SCALE As Long = CAP + 53
    Const WS_CHILD As Long = &H40000000
    Const WS_VISIBLE As Long = &H10000000
    Const SWP_NOMOVE As Long = &H2
    Const SWP_NOSIZE As Long = 1
    Const SWP_NOZORDER As Long = &H4
    Const HWND_BOTTOM As Long = 1
    Dim iDevice As Long
    Dim evn As Long

Private Sub UserForm_Initialize()
Dim iHeight As Long
Dim iWidth As Long
    iHeight = picCapture.Height
    iWidth = picCapture.Width
        evn = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 800, 600, picCapture.hwnd, 0)
        If SendMessage(evn, CAP_DRIVER_CONNECT, iDevice, 0) Then
            Call SendMessage(evn, CAP_SET_SCALE, True, 0)
            Call SendMessage(evn, CAP_SET_PREVIEWRATE, 66, 0)
            Call SendMessage(evn, CAP_SET_PREVIEW, True, 0)
            Call SetWindowPos(evn, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, _
                                   SWP_NOMOVE Or SWP_NOZORDER)
        Else
            DestroyWindow (evn)
        End If
    End Sub

Private Sub CommandButton1_Click()
Dim sil As ChartObject
Call SendMessage(evn, CAP_EDIT_COPY, 0, 0)
evnresim = "C:\evnresim.jpg"
With ActiveSheet.ChartObjects.Add(0, 0, picCapture.Width, picCapture.Height).Chart
    .Paste
    .Export evnresim
    For Each sil In ActiveSheet.ChartObjects
        sil.Delete
    Next sil
    Image1.Picture = LoadPicture(evnresim)
    Sayfa1.Range("C6").Copy
    With Sayfa3
        .Range("B65536").End(3)(2, 1).PasteSpecial xlPasteValues
        .Range("C65536").End(3)(2, 1) = VBA.Now: .Select
        ActiveSheet.Pictures.Insert(evnresim).Select
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Top = .Range("C65536").End(3).Top
        Selection.ShapeRange.Left = .Range("d65536").End(3).Left
        Selection.ShapeRange.Height = .Range("c65536").End(3).Height
        Selection.ShapeRange.Width = .Range("d65536").End(3)(2, 1).Width
    End With
   Kill evnresim
End With
Application.CutCopyMode = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call SendMessage(evn, CAP_DRIVER_DISCONNECT, iDevice, 0)
DestroyWindow (evn)
End Sub

Merhaba Murat bey
kodlarda

.Export evnresim

kısmında hata veriyor neden olabilir?
not: ofis 2003 kullanıyorum

 

[esad45]

dosya üzerinde yapabilirmisiniz yapamadım ben

Bunun anlamı: Kill evnresim satırı ile resmi siliriyoruz......
Eğer koddaki Kill evnresim satırını silerseniz resmi silmemiş/sildirmemiş olursunuz.............

Anlatabildim mi ?

dosya üzerinde yapabilirmisiniz yapamadım ben

 

[esad45]

Sayın murat bey yardımlarınız bekliyorum

 

[Murat OSMA]

Bu konuda daha sonra yeni bir konu açıldığını görmüştüm orada baya ilerleme oldu diye biliyorum ve bu nedenle konuya sonradan müdahil olmak istemiyorum.

İyi günler.

 

[esad45]

bu konuda bir cevap verecek yok mu

 

[seyhan6591]

64 bitte çalışır mı?

Bu konuda daha sonra yeni bir konu açıldığını görmüştüm orada baya ilerleme oldu diye biliyorum ve bu nedenle konuya sonradan müdahil olmak istemiyorum.

İyi günler.

Murat bey bu kodlar 32 bit işletim sisteminde düzgün çalışıyor, gerektiği gibi kullanıyorum, ancak 64 bit için işe yarar mı. Denedim, çalışmadı. Acaba birşeyleri eksik mi tanımladım, yoksa sadece 64 bite mi uyumlu değil. Nasıl bir yol izleyebilirim? Konu hangi başlık altında devam ettirildi? Bu kodları müşteri veya numune tanımlama fotosu çekmek için kullanmak istiyorum.

Teşekürler