Resimleri yazdırma sayfaya aktararak

[Hikmet26]

Bu sorunu uzun süredir çözemedim. Arkadaşlar ve üstadlarım yardımlarınızı bekliyorum.

Sayfa1 de j stununda resimlerin aderesleri yazılı onlarıda yolluyorum. Resimleri koymanız gereken yer "c:\belgelerim\Alınan Dosyalarım\" çok acil bir şekilde yardıma ihtiyacım var...

Form üzerinde bulunan önceki ve sonraki tuşları çalışıyor Hamitcan Kardeşimden Allah razı olsun ilgilenmişti...

Yapmak istediğim Yazdır tuşuna basıldığı zaman form üzerinde bulunan resimler sayfa 2 bulunan imagelere yelrştirilsin ve label captionları ilgili resmin yanında bulunan hücrelere yerleşsin yazıcıdan çıkartılsın sonra sayfa 2 deki bütün resimler silinsin hücreler boşaltılsın dosya kaydedilsin çıkılsın...

İlgilenen arkadaşlara çok teşekkürler.

 

[Hikmet26]

Arkadaşlar zor durumdayım lütfen yardımlarınızı bekliyorum.

 

[hamitcan]

Bu kodları öncekilerle değiştirin.

Dim i, k, s
Dim Sh As Object
Private Sub CommandButton1_Click()
CommandButton2.Enabled = True

If k + 9 = s Then CommandButton1.Enabled = False
j = 1
For i = 1 To 9
k = k + 1

 Controls("image" & i).Picture = LoadPicture(Cells(k + 10, "j"))
 Controls("label" & j) = Cells(k + 10, "b")
 Controls("label" & j + 1) = Cells(k + 10, "e")
 Controls("label" & j + 2) = Cells(k + 10, "g")
 Controls("label" & j + 3) = Cells(k + 10, "f")
 Controls("label" & j + 4) = Cells(k + 10, "d")
 Controls("label" & j + 5) = Cells(k + 10, "c")
 j = j + 6
Next
resimler
End Sub

Private Sub CommandButton2_Click()
CommandButton1.Enabled = True
If k = 9 Then CommandButton2.Enabled = False
j = 49
For i = 9 To 1 Step -1
k = k - 1
 Controls("image" & i).Picture = LoadPicture(Cells(k + 2, "j"))
 Controls("label" & j) = Cells(k + 2, "b")
 Controls("label" & j + 1) = Cells(k + 2, "e")
 Controls("label" & j + 2) = Cells(k + 2, "g")
 Controls("label" & j + 3) = Cells(k + 2, "f")
 Controls("label" & j + 4) = Cells(k + 2, "d")
 Controls("label" & j + 5) = Cells(k + 2, "c")
 
 j = j - 6
Next
resimler
End Sub
Sub resimler()
Sh.Image1.Picture = Me.Image1.Picture
Sh.Image2.Picture = Me.Image2.Picture
Sh.Image3.Picture = Me.Image3.Picture
Sh.Image4.Picture = Me.Image4.Picture
Sh.Image5.Picture = Me.Image5.Picture
Sh.Image6.Picture = Me.Image6.Picture
Sh.Image7.Picture = Me.Image7.Picture
Sh.Image8.Picture = Me.Image8.Picture
Sh.Image9.Picture = Me.Image9.Picture

For i = 1 To 6
    Sh.Cells(i + 11, "e") = Controls("label" & i)
    Sh.Cells(i + 11, "n") = Controls("label" & i + 6)
    Sh.Cells(i + 11, "w") = Controls("label" & i + 12)
    
    Sh.Cells(i + 33, "e") = Controls("label" & i + 18)
    Sh.Cells(i + 33, "n") = Controls("label" & i + 25)
    Sh.Cells(i + 33, "w") = Controls("label" & i + 31)

    Sh.Cells(i + 55, "e") = Controls("label" & i + 36)
    Sh.Cells(i + 55, "n") = Controls("label" & i + 42)
    Sh.Cells(i + 55, "w") = Controls("label" & i + 48)
Next
End Sub

Private Sub CommandButton4_Click()
Unload Me
End Sub

Private Sub CommandButton5_Click()
resimler
Unload Me
Sheets("sayfa2").PrintOut
End Sub

Private Sub UserForm_Initialize()
Set Sh = Sheets("Sayfa2")
s = [j65536].End(3).Row - 10
j = 1
For i = 1 To 9
 Controls("image" & i).Picture = LoadPicture(Cells(i + 1, "j"))
 Controls("label" & j) = Cells(i + 1, "b")
 Controls("label" & j + 1) = Cells(i + 1, "e")
 Controls("label" & j + 2) = Cells(i + 1, "g")
 Controls("label" & j + 3) = Cells(i + 1, "f")
 Controls("label" & j + 4) = Cells(i + 1, "d")
 Controls("label" & j + 5) = Cells(i + 1, "c")
 j = j + 6
Next
resimler
If i = 10 Then CommandButton2.Enabled = False
End Sub

 

[Hikmet26]

Daha iyisi olamazdı. Kardeşim ellerine emeğine sağlık. Allah razı olsun. Resmen acdsee gibi resim programı oldu diyebiliriz. Çok çok Teşekkürler...