PC WORLD Online - Word İçin Faydalı Makrolar

Resim Boyutlandırma

Bir Word belgesinin içinde resim kullanıyorsunuz. Ancak paragrafları formatlarken resimlerin boyutunu da değiştirmek zorunuza gidiyorsa, bunu bir maro yardımı ile otomatik olarak yapabilirsiniz. Resim boyutlandırma makromuz seçili olan bir resmi, resmin bulunduğu paragrafın genişliğine göre büyütüyor veya küçültüyor. Bu arada perspektifi bozmamak için X ve Y eksenlerini eşit ölçülerde değiştiriyor. Eğer sayfanın X veya Y eksenlerinden birinde taşma varsa, makro en büyük eksene göre resmi otomatik olarak boyutlandırıyor.

makro 3: resimboyut

Sub MAIN
Ret2 = ScaleObjectDefault
Select Case Ret2
	Case - 1
		MsgBox "Lütfen önce boyutladırılacak olan resmi seçin."
	Case - 2
		MsgBox "Resim boyutlandırılamıyor."
	Case Else
End Select
End Sub

Function ScaleObjectDefault
NL$ = Chr$(13)
Dim dlg As ToolsOptionsGeneral
GetCurValues dlg
CurrentUnits = dlg.Units

ToolsOptionsGeneral .Units = 1
Dim dlg2 As FilePageSetup
GetCurValues dlg2
LeftMargin$ = dlg2.LeftMargin
RightMargin$ = dlg2.RightMargin
PageWidth$ = dlg2.PageWidth
PageHeight$ = dlg2.PageHeight
TopMargin$ = dlg2.TopMargin
BottomMargin$ = dlg2.BottomMargin
LeftMargin = Val(LeftMargin$)
RightMargin = Val(RightMargin$)
PageWidth = Val(PageWidth$)
PageHeight = Val(PageHeight$)
TopMargin = Val(TopMargin$)
BottomMargin = Val(BottomMargin$)

REM Get current indents
Dim Dlg3 As FormatParagraph
GetCurValues Dlg3
XLeft$ = Dlg3.LeftIndent
XRight$ = Dlg3.RightIndent
XLeft = Val(XLeft$)
XRight = Val(XRight$)
XLeft = LeftMargin + XLeft
If XRight > 0 Then
	XRight = PageWidth - RightMargin - XRight
Else
	XRight = PageWidth - RightMargin
EndIf

On Error Goto NotaPicture
Dim Dlg4 As FormatPicture
GetCurValues Dlg4
tSizeX$ = Dlg4.SizeX
tSizeY$ = Dlg4.SizeY
tScaleX$ = Dlg4.ScaleX
tScaleY$ = Dlg4.ScaleY
SizeX = Val(tSizeX$)
SizeY = Val(tSizeY$)
ScaleX = Val(tScaleX$)
ScaleY = Val(tScaleY$)
RealX = SizeX / ScaleX * 100
RealY = SizeY / ScaleY * 100

On Error Goto CantScale
AvailWidth = XRight - XLeft
AvailHeight = PageHeight - TopMargin - BottomMargin
ScaleX = AvailWidth / RealX * 100
ScaleY = AvailHeight / RealY * 100

If ScaleX < ScaleY Then
	ScaleAmount = ScaleX
Else
	ScaleAmount = ScaleY
EndIf

ScaleAmount$ = Str$(ScaleAmount) + "%"
FormatPicture .SetSize = 0, .ScaleX = ScaleAmount$, \
		.ScaleY = ScaleAmount$
ScaleObjectDefault = 0
Goto EndScaleDefault

CantScale:
ScaleObjectDefault = - 2
Goto EndScaleDefault

NotaPicture:
ScaleObjectDefault = - 1

EndScaleDefault:
ToolsOptionsGeneral .Units = CurrentUnits
Err = 0
End Function