Klasor içerisindeki resimlerin Dimensions ayarlarını değiştirebilirmiyiz.

[Kemal Demir]

Arkadaslar merhaba;

"C:\Resimlerim\Sablon\pptornek.bmp" dosyamın Dimensions ayarlarını "718X721" yapmak istiyorum.

Kod ile böyle birşey mumkunmudur.

Teşekkurler.

 

[mesuttasar]

Sayın Uzmanım, yabancı bir sitede excel dosasına alınan resimlerin istenilen büyüklüte getirimesi ile ilgili bir kod buldum.
Belki size bir fikir verebilir.

Option Explicit
Sub testme()

Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sayfa1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
With .Range("[COLOR=Red]a1:B20[/COLOR]")           [COLOR=Red]'getirilen resim a1 den b20 aralığında sayfaya ekleniyor[/COLOR]
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
End With

End Sub

 

[Kemal Demir]

Mesut bey,

Teşekkurler.Faydası olacagı kanısındayım.

İyi çalışmalar.

 

[Kemal Demir]

Mesut Bey,

Olmadı.Zannedersem bıraz daha aramamda fayda var.

Emeğinize sağlık.

 

[mesuttasar]

Sayın uzmanım, kodlar sizin yapmayı istediğiniz klasör içerisindeki resimlerin boyutlandırmasını yapmıyor , ben kodları boş bir modüle kopyalayıp çalıştırdığımda yukarıdaki gibi b20 hücresi yüksekliğinde sayfa 1 e ekledi.

 

[Kemal Demir]

Evet bu konuda haklısınız.

Calistiğim kodu paylaşıyorum.Teşekkurler.

Application.DisplayAlerts = True
     Const Viewer As String = "C:\Program Files\IrfanView\i_view32.exe"
     Selection.Copy
     Shell Viewer, 1
     Application.SendKeys "^v"
If Dir("C:\Zirz", vbDirectory) = Empty Then
MkDir "C:\Zirz"
End If
ChDir "C:\Zirz"
[b]'Application.SendKeys "^r"  resize tanımlayamadıgım yer oyuzden kapalı.[/b]
Application.SendKeys "^s"
isim = ActiveSheet.Name
Application.SendKeys "Bay" & "_" & isim & "_" & x [b]'Int(Rnd() * 15005210)[/b]
Application.SendKeys "{ENTER}"
DoEvents: DoEvents
'Application.SendKeys "%FX"
DoEvents: DoEvents
Next

Teşekkurler tekrardan.

 

[mesuttasar]

Sayın uzmanım , yazmış olduğunuz kodlara baka kaldım sadece , hiç birşey anlayamadım doğrusu ben kafanızı bulandırmayıp köşeme çekilip çalışmalarınızı izlesem daha hayırlı olacak galiba

Kolay gelsin

 

[Kemal Demir]

Iyi akşamlar Mesut bey,

Teveccünüzden dolayı teşekkurler.Inanın bende bazı şeyleri zamanla öğreniyorum.

İlginizden dolayı teşekkurler.