İstenilen hücreye boyut belirterek resim ekletmek

[desk]

Sub Klasördeki_Dosyalara_Formül_Uygula()
Dim Klasör As Object
Dim İlk_Süre As Date, Son_Süre As Date, Toplam_Süre As Date
Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçiniz !", 1)
İlk_Süre = Time
[A2:B65536].ClearContents
Liste (Klasör.Items.Item.Path)
Alt_Liste (Klasör.Items.Item.Path)
Set Klasör = Nothing
Son_Süre = Time
Toplam_Süre = Format(Son_Süre - İlk_Süre, "hh:mm:ss")
MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & "İşlem süresi ; " & Toplam_Süre, vbInformation
End Sub

Private Sub Liste(Yol As String)
Dim Dosya As String, Hedef_Dosya As Workbook
On Error Resume Next
Dosya = Dir(Yol & "\*.xls")

While Dosya <> ""
Application.ScreenUpdating = False
DoEvents
Set Hedef_Dosya = Workbooks.Open(Yol & "\" & Dosya, False, False)
Range("A1:A2").Formula = "=J12+SUM(H13)-SUM(I13)"

Hedef_Dosya.Close True
Dosya = Dir
Application.ScreenUpdating = True
Wend
End Sub

Private Sub Alt_Liste(Yol As String)
Dim Alt_Klasör As Object, Alt_Dosya As Object, Dosya As String, Hedef_Dosya As Workbook
Set Alt_Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders

On Error GoTo Devam

For Each Alt_Dosya In Alt_Klasör
Dosya = Dir(Alt_Dosya.Path & "\*.xls")
While Dosya <> ""
Application.ScreenUpdating = False
DoEvents
Set Hedef_Dosya = Workbooks.Open(Alt_Dosya & "\" & Dosya, False, False)
Range("B1:B2").Formula = "=J12+SUM(H13)-SUM(I13)"
Hedef_Dosya.Close True
Dosya = Dir
Application.ScreenUpdating = True
Wend
Alt_Liste (Alt_Dosya.Path)
Devam:
Next
Set Alt_Klasör = Nothing
End Sub


BURDA KLASÖRDEKİ İSTEDİĞİM HÜCREYE FORMÜL KOYABİLDİĞİM GİBİ C15 E NASIL BOYUTUNU İSTEDİĞİM GİBİ BELİRLEYEBİLDİĞİM RESİM KOYDURABİLİRİM. ÖRNEK RESİM D:/RESIM/A.jpg bunu klasörün içindeki tüm dosyalara koymak istiyorum.

 

[Evolver]

aşağıdaki kod dediğiniz klasörde bulunan a.jpg adlı resmi dosyaya ekler. bu satırı tüm dosyalara formül yazdırdığınız döngüde uygun yere koyarsanız dosyayı açtıktan ve formülleri yazdırdıktan sonra resmide eklemiş olursunuz.
kodda dikkat ederseniz 4 tane rakam var.
75: soldan uzaklık
96: üstten uzaklık
150: resmin yüksekliği
200: resmin genişliği
buradaki rakamları C15 hücresini tutturana kadar değiştirirsiniz. boyutunada siz karar verirsiniz.

ActiveSheet.Shapes.AddPicture "D:\resim\a.jpg", True, True, 75, 96, 150, 200

 

[desk]

excel dosyasındaki resmi nasıl okuyup basabiliyoruz.? hücre mi konummu nasıl yakalıyoruz resmi?

 

[Evolver]

nasıl yani anlayamadım
kodlarla bir excel dosyasına hem hücre adresi belirterek hem de konum belirterek resim eklenebilir. basmak yakalamak ?????