Excel dosyasının içine tek tuşla resim çekme yapıştırma... YARDIM...

[vimpir]

Merhaba arkadaşlar Makrolarla excel üzerinde hayal ettiklerimizi yapabiliyoruz... benim bir sorum olacak bildiniz gibi print screen tuşu ile masa üstünün resmini çekebiliyoruz painte yapıştırıp resim olarak kaydede biliyoruz... Peki Print Screen tuşuna bastığımızda başka bir tuşa basmadan excele verilen boyutlara yapıştıra bilirmi? böyle bir makro varmı acaba varsa paylaşabilirmisiniz...lütfen...

 

[halit3]

örnek dosyayı incelermisiniz.

Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Sub sayfayaresimal()
dosya_adı = ActiveWorkbook.Name
Application.VBE.MainWindow.Visible = False
Application.WindowState = xlMinimized
On Error Resume Next
Call keybd_event(vbKeySnapshot, 0, 0, 0) ' Hali hazırda bulunan ekranın fotoğrafını yakaladı
DoEvents ' Clipboarda Çekilen Resmin Kopyalanması için Bilgisayarı beklet
Application.WindowState = xlNormal
Windows(dosya_adı).Activate
Range("a1").Select
ActiveSheet.Paste
Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
nesne = ActiveSheet.Shapes(Picture.Name).OLEFormat.Object.Name
ActiveSheet.Shapes(nesne).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 400
Selection.ShapeRange.Width = 600
End If
Next Picture
End Sub

 

[vimpir]

Arkadaşlar kodlarla ekranın fotosunu pc ye almak için verdiğiniz kodlardan biraz değişiklikler yaptım ama bir türlü çalıştıramadım... benim sorunum userform yaptım excelle aynı anda açılmasın diye bir kod yaptım... birde butona her tıkladığımda masaüstüne kaydetmesini istiyorum resimi ve her tıkladığımda resim 1 resim 2 diye gitmesinin istiyorum aynı resmin üstüne kaydetmesin yani örnekte daha iyi anlayacaksınız... yardımcı olursanız sevinirim....

 

[halit3]

Arkadaşlar kodlarla ekranın fotosunu pc ye almak için verdiğiniz kodlardan biraz değişiklikler yaptım ama bir türlü çalıştıramadım... benim sorunum userform yaptım excelle aynı anda açılmasın diye bir kod yaptım... birde butona her tıkladığımda masaüstüne kaydetmesini istiyorum resimi ve her tıkladığımda resim 1 resim 2 diye gitmesinin istiyorum aynı resmin üstüne kaydetmesin yani örnekte daha iyi anlayacaksınız... yardımcı olursanız sevinirim....

bu kodu denermisiniz.

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub CommandButton1_Click()
Application.WindowState = xlMinimized
Klasor = ThisWorkbook.Path
Dosya_adi = "resim"
sat = 0
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files
If Mid(Dosya.Name, 1, Len(Dosya_adi)) = Dosya_adi Then
sat = sat + 1
End If
Next
UserForm1.Hide
Call keybd_event(vbKeySnapshot, 0, 0, 0)
DoEvents
Set grafik = ActiveSheet.ChartObjects.Add(, , 1000, 1000)
grafik.Chart.Paste
grafik.Chart.Export ThisWorkbook.Path & "\" & Dosya_adi & sat + 1 & ".jpg"
grafik.Delete
UserForm1.Show
Application.WindowState = xlNormal
End Sub

 

[vimpir]

bu kodu denermisiniz.

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub CommandButton1_Click()
Application.WindowState = xlMinimized
Klasor = ThisWorkbook.Path
Dosya_adi = "resim"
sat = 0
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files
If Mid(Dosya.Name, 1, Len(Dosya_adi)) = Dosya_adi Then
sat = sat + 1
End If
Next
UserForm1.Hide
Call keybd_event(vbKeySnapshot, 0, 0, 0)
DoEvents
Set grafik = ActiveSheet.ChartObjects.Add(, , 1000, 1000)
grafik.Chart.Paste
grafik.Chart.Export ThisWorkbook.Path & "\" & Dosya_adi & sat + 1 & ".jpg"
grafik.Delete
UserForm1.Show
Application.WindowState = xlNormal
End Sub

Emeğine sağlık tam istediğim gibi... Saollasın...

 

[halit3]

Emeğine sağlık tam istediğim gibi... Saollasın...

iyi çalışmalar