Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

8 Şubat 2010 Pazartesi

To Make Shape On The UserForm




'UserForm1

'A) VBProject References List

'Visual Basic For Application
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'Microsoft Forms 2.0 Object Library

'B) Addition Tools on UserForm1

'Frame1
'Frame1\Image1, Label1, Label2, ComboBox1

Option Explicit
Private Çizim As New Class1
Dim i As Single, ii As Single
Dim Nesne As Shape
Dim EğriX(1 To 24) As Single
Dim EğriY(1 To 24) As Single
Dim DoğruX(1 To 24) As Single
Dim DoğruY(1 To 24) As Single
Dim Üstten As Double, Soldan As Double
Private Sub UserForm_Initialize()

Me.Caption = "[PBİD®] Make Shape On The UserForm"
Call EkranDüzenle
Set Çizim.FormTuvaliYap = Me
With ComboBox1

.AddItem "Dörtgen [Box]"
.AddItem "Metin [TextEffect]"
.AddItem "Yazı Sanatı [WordArt]"
.AddItem "Eğri [Curve]"
.AddItem "Elips [Oval]"
.AddItem "Çizgi [Line]"
.AddItem "Çokgen [FreeForm]"

End With

End Sub
Private Sub ComboBox1_Change()

On Error Resume Next
Select Case ComboBox1.ListIndex

Case 0: Call Dörtgen
Case 1: Call Metin
Case 2: Call YazıSanatı
Case 3: Call Eğri
Case 4: Call ElipsDaire
Case 5: Call Çizgi
Case 6: Call Çokgen

End Select

End Sub
Private Sub Dörtgen() '[Box]

On Error Resume Next
Çizim.TuvalSil
Üstten = VBA.Round(((Me.Height - 30 - 6 - 24 - 300) / 2) + (30 + 6), 0)
Soldan = VBA.Round((Me.Width - 300) / 2, 0)
Set Nesne = Çizim.DörtgenNesne(Soldan + 0, Üstten + 0, 300, 300)
If Not Nesne Is Nothing Then

With Nesne

With .Fill

.ForeColor.RGB = VBA.RGB(255, 0, 0)
.BackColor.SchemeColor = 32
.TwoColorGradient msoGradientVertical, 1

End With
With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(255, 0, 0)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With

End With

End If
Çizim.NesneBoya

End Sub
Private Sub Metin() '[TextEffect]

On Error Resume Next
Çizim.TuvalSil
Üstten = VBA.Round(((Me.Height - 30 - 6 - 24 - 300) / 2) + (30 + 6), 0)
Soldan = VBA.Round((Me.Width - 300) / 2, 0)
Set Nesne = Çizim.DörtgenNesne(Soldan + 0, Üstten + 0, 300, 300)
If Not Nesne Is Nothing Then

With Nesne

With .Fill

.ForeColor.RGB = VBA.RGB(255, 0, 0)
.BackColor.SchemeColor = 5
.Transparency = 0.1
.Patterned msoPatternDiagonalBrick

End With
With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(255, 0, 0)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With
With .TextFrame

With .Characters

.Text = "PBİD®"
.Font.Bold = True
.Font.Color = VBA.RGB(255, 0, 0)
.Font.Size = 72

End With
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter

End With

End With

End If
Çizim.NesneBoya

End Sub
Private Sub YazıSanatı() '[WordArt]

On Error Resume Next
Çizim.TuvalSil
Üstten = VBA.Round(((Me.Height - 30 - 6 - 24 - 150) / 2) + (30 + 6), 0)
Soldan = VBA.Round((Me.Width - 250) / 2, 0)
Set Nesne = Çizim.MetinNesne(Soldan + 0, Üstten + 0, msoTextEffect22, "PBİD ®", "Veranda", 72)
Çizim.NesneBoya

End Sub
Private Sub Eğri() '[Curve]

On Error Resume Next
Çizim.TuvalSil
Üstten = VBA.Round(((Me.Height - 30 - 6 - 24 - 300) / 2) + (30 + 6), 0)
Soldan = VBA.Round((Me.Width - 250) / 2, 0)
EğriX(1) = 40 + Soldan: EğriY(1) = 240 + Üstten
EğriX(2) = 80 + Soldan: EğriY(2) = 20 + Üstten
EğriX(3) = 120 + Soldan: EğriY(3) = 240 + Üstten
EğriX(4) = 160 + Soldan: EğriY(4) = 20 + Üstten
EğriX(5) = 200 + Soldan: EğriY(5) = 240 + Üstten
EğriX(6) = 40 + Soldan: EğriY(6) = 240 + Üstten
Set Nesne = Çizim.EğriNesne(EğriX, EğriY)
With Nesne

With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(255, 0, 0)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With

End With
Çizim.NesneBoya

End Sub
Private Sub ElipsDaire() '[EllipseCircle]

On Error Resume Next
Çizim.TuvalSil
Üstten = VBA.Round(((Me.Height - 30 - 6 - 24 - 300) / 2) + (30 + 6), 0)
Soldan = VBA.Round((Me.Width - 300) / 2, 0)
Set Nesne = Çizim.DaireNesne(Soldan + 170, Üstten + 120, 70)
With Nesne

.Fill.ForeColor.RGB = RGB(255, 0, 0)
With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(255, 0, 0)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With

End With
Set Nesne = Çizim.OvalNesne(Soldan + 220, Üstten + 120, 45, 70)
With Nesne

.Fill.ForeColor.RGB = RGB(255, 255, 0)
With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(255, 255, 0)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With

End With
Set Nesne = Çizim.OvalNesne(Soldan + 95, Üstten + 120, 75, 35)
With Nesne

.Fill.ForeColor.RGB = RGB(0, 255, 255)
With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(0, 255, 255)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With

End With
Çizim.NesneBoya

End Sub
Private Sub Çizgi() '[Line]

On Error Resume Next
Çizim.TuvalSil
Set Nesne = Çizim.DörtgenNesne(60, 120, 100, 30) 'Sol - Üst - Genişlik - Yükseklik
With Nesne.Fill

.ForeColor.SchemeColor = 5
.BackColor.SchemeColor = 6
.Transparency = 0.1
.Patterned msoPattern50Percent

End With
Set Nesne = Çizim.ÇizgiNesne(160, 135, 200, 135):
With Nesne.Line

.Weight = 2
.ForeColor.SchemeColor = 4
.BeginArrowheadStyle = msoArrowheadOval

End With
Set Nesne = Çizim.ÇizgiNesne(200, 135, 200, 195): Nesne.Line.Weight = 1
With Nesne.Line

.Weight = 2
.ForeColor.SchemeColor = 4

End With
Set Nesne = Çizim.ÇizgiNesne(200, 195, 240, 195): Nesne.Line.Weight = 1
With Nesne.Line

.Weight = 2
.ForeColor.SchemeColor = 4
.EndArrowheadStyle = msoArrowheadStealth

End With
Set Nesne = Çizim.DörtgenNesne(240, 180, 100, 30)
With Nesne.Fill

.ForeColor.SchemeColor = 5
.BackColor.SchemeColor = 6
.Transparency = 0.1
.Patterned msoPattern50Percent

End With
Set Nesne = Çizim.DörtgenNesne(240, 240, 100, 30)
With Nesne.Fill

.ForeColor.SchemeColor = 5
.BackColor.SchemeColor = 6
.Transparency = 0.1
.Patterned msoPattern50Percent

End With
Set Nesne = Çizim.ÇizgiNesne(180, 135, 180, 255): Nesne.Line.Weight = 1
With Nesne.Line

.Weight = 2
.ForeColor.SchemeColor = 4

End With
Set Nesne = Çizim.ÇizgiNesne(180, 255, 240, 255): Nesne.Line.Weight = 1
With Nesne.Line

.Weight = 2
.ForeColor.SchemeColor = 4
.EndArrowheadStyle = msoArrowheadStealth

End With
Çizim.NesneBoya

End Sub
Private Sub Çokgen() 'FreeForm

On Error Resume Next
Çizim.TuvalSil
Üstten = VBA.Round(((Me.Height - 30 - 6 - 24 - 300) / 2) + (30 + 6), 0)
Soldan = VBA.Round((Me.Width - 300) / 2, 0)
DoğruX(1) = (60 + Soldan): DoğruY(1) = (300 + Üstten)
DoğruX(2) = (152 + Soldan): DoğruY(2) = (232 + Üstten)
DoğruX(3) = (243 + Soldan): DoğruY(3) = (300 + Üstten)
DoğruX(4) = (208 + Soldan): DoğruY(4) = (187 + Üstten)
DoğruX(5) = (301 + Soldan): DoğruY(5) = (116 + Üstten)
DoğruX(6) = (187 + Soldan): DoğruY(6) = (116 + Üstten)
DoğruX(7) = (151 + Soldan): DoğruY(7) = (3 + Üstten)
DoğruX(8) = (116 + Soldan): DoğruY(8) = (116 + Üstten)
DoğruX(9) = (1 + Soldan): DoğruY(9) = (116 + Üstten)
DoğruX(10) = (95 + Soldan): DoğruY(10) = (187 + Üstten)
DoğruX(11) = (60 + Soldan): DoğruY(11) = (300 + Üstten)
Set Nesne = Çizim.ÇokgenNesne(DoğruX, DoğruY, False)
If Not Nesne Is Nothing Then

With Nesne

With .Fill

.PresetTextured msoTextureWovenMat

End With
With .Line

.Visible = msoTrue
.Weight = 6
.ForeColor.SchemeColor = 12
.BackColor.RGB = VBA.RGB(255, 0, 0)
.DashStyle = msoLineSolid
.Pattern = msoPattern50Percent
.Transparency = 50 / 100
.Weight = 24

End With

End With

End If
Çizim.NesneBoya

End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 432
.Width = 432
.BackColor = vbWhite
With Frame1

.Caption = ""
.Left = -1
.Top = -1
.Height = 30
.Width = Me.Width + 12
.Picture = LoadPicture("D:\Mustafa ULUSARAÇ\Blogspot\ZarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeStretch
.SpecialEffect = fmSpecialEffectFlat
.BackColor = vbWhite
With Image1

.Left = 1.5
.Top = 1.5
.Height = 24
.Width = 24
.BorderColor = vbBlue
.BackStyle = fmBackStyleTransparent
.Picture = LoadPicture("D:\Mustafa ULUSARAÇ\Blogspot\Örnekİkonlar\PBİD.ico")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip

End With
With Label1

.Left = 1.5 + 24 + 3
.Top = 1.5
.Caption = "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Height = 12
.Width = 180
.Font.Bold = True
.ForeColor = vbBlue

End With
With Label2

.Left = 1.5 + 24 + 3
.Top = 13.5
.Caption = "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Height = 12
.Width = 180
.Font.Bold = True
.ForeColor = vbBlue

End With
With ComboBox1

.Top = 6
.Height = 18
.Width = 120
.Left = Me.Width - 12 - .Width
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Style = fmStyleDropDownCombo
.ForeColor = vbBlue
.Font.Bold = True
.BackColor = vbWhite

End With

End With

End With

End Sub

'Module1

Option Explicit
Public Sub FormAç()

On Error Resume Next
UserForm1.Show 0

End Sub

'Class1

Option Explicit
Option Compare Text
Private Type KILAVUZ

Veri1 As Long
Veri2 As Integer
Veri3 As Integer
Veri4(0 To 7) As Byte

End Type
Private Type ResimTarifi

Boyut As Long
Tip As Long
Resim As Long
Eldeki As Long

End Type
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As ResimTarifi, RefIID As KILAVUZ, ByVal fPictureOwnsHandle As Long, ResimNo As IPicture) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private i As Integer
Private NesneÇerçeve As Shape
Private Tayf As Long
Private Sol As Single
Private Üst As Single
Private En As Single
Private Boy As Single
Private NoktaX1 As Single
Private NoktaY1 As Single
Private NoktaX2 As Single
Private NoktaY2 As Single
Private FormTuval As MSForms.UserForm
Private NesneTuval As Object
Private SayfaTuval As Worksheet, Sayfa As Worksheet
Private Durum As Boolean
Private Kontrol As Long, GeçerliResim As Long, EldekiResim As Long, Eldeki As Long, EldekiResimTipi As Long, Kopyalanan As Long
Private Okunan As Long, ResimBilgi As ResimTarifi, Yamalamak As KILAVUZ, ResimNo As IPicture
Private Sub Class_Initialize()

For Each Sayfa In ThisWorkbook.Worksheets

If Sayfa.Name = "Tuval" Then GoTo Devam

Next Sayfa
ThisWorkbook.Worksheets.Add Before:=Sheets(1)
ThisWorkbook.ActiveSheet.Name = "Tuval"
Devam:
Set SayfaTuval = ThisWorkbook.Worksheets("Tuval")
Call TuvalSil 'MevcuduSil

End Sub
Private Sub Class_Terminate()

On Error Resume Next
Call TuvalSil 'MevcuduSil
ThisWorkbook.Saved = True
Set SayfaTuval = Nothing
Set FormTuval = Nothing
Set NesneTuval = Nothing

End Sub
Public Sub TuvalSil()

On Error Resume Next
Call MevcuduSil
Call TuvaliSilmek

End Sub
Public Sub TuvaliSilmek()

On Error Resume Next
If Durum Then

FormTuval.Picture = LoadPicture("")

Else

NesneTuval.Picture = LoadPicture("")

End If

End Sub
Private Sub MevcuduSil()

On Error GoTo Hata
Do While SayfaTuval.Shapes.Count > 0

SayfaTuval.Shapes(1).Delete

Loop
Hata:
Exit Sub

End Sub

Public Function DörtgenNesne(Sol As Single, Üst As Single, En As Single, Boy As Single) As Shape

On Error GoTo Hata
Set DörtgenNesne = SayfaTuval.Shapes.AddShape(msoShapeRectangle, Sol, Üst, En, Boy)
Exit Function
Hata:
Set DörtgenNesne = Nothing
Exit Function

End Function
Public Function MetinNesne(Sol As Single, Üst As Single, Effect As MsoPresetTextEffect, Text As String, Optional FontName As String = "Arial", Optional FontSize As Single = 10, Optional FontBold As MsoTriState = msoFalse, Optional FontItalic As MsoTriState = msoFalse) As Shape

On Error GoTo Hata
Set MetinNesne = SayfaTuval.Shapes.AddTextEffect(Effect, Text, FontName, FontSize, FontBold, FontItalic, Sol, Üst)
Exit Function
Hata:
Set MetinNesne = Nothing
Exit Function

End Function
Public Function EğriNesne(Xs() As Single, Ys() As Single) As Shape

On Error GoTo Hata
With SayfaTuval.Shapes.BuildFreeform(msoEditingAuto, Xs(LBound(Xs)), Ys(LBound(Ys)))

For i = LBound(Xs) + 1 To UBound(Xs)

.AddNodes msoSegmentCurve, msoEditingAuto, Xs(i), Ys(i)

Next
Set EğriNesne = .ConvertToShape

End With
Exit Function
Hata:
Set EğriNesne = Nothing
Exit Function

End Function
Public Function ÇokgenNesne(Xs() As Single, Ys() As Single, Closed As Boolean) As Shape

On Error GoTo Hata
With SayfaTuval.Shapes.BuildFreeform(msoEditingAuto, Xs(LBound(Xs)), Ys(LBound(Ys)))

For i = LBound(Xs) + 1 To UBound(Xs)

.AddNodes msoSegmentLine, msoEditingAuto, Xs(i), Ys(i)

Next
If Closed Then

.AddNodes msoSegmentLine, msoEditingAuto, Xs(LBound(Xs)), Ys(LBound(Ys))

End If
Set ÇokgenNesne = .ConvertToShape

End With
Exit Function
Hata:
Set ÇokgenNesne = Nothing
Exit Function

End Function
Public Function OvalNesne(XOrta As Single, YOrta As Single, XÇap As Single, YÇap As Single) As Shape

On Error GoTo Hata
Sol = XOrta - XÇap
Üst = YOrta - YÇap
En = XÇap * 2
Boy = YÇap * 2
Set OvalNesne = SayfaTuval.Shapes.AddShape(msoShapeOval, Sol, Üst, En, Boy)
Exit Function
Hata:
Set OvalNesne = Nothing
Exit Function

End Function
Public Function DaireNesne(XOrta As Single, YOrta As Single, Çap As Single) As Shape

On Error GoTo Hata
Sol = XOrta - Çap
Üst = YOrta - Çap
En = Çap * 2
Boy = Çap * 2
Set DaireNesne = SayfaTuval.Shapes.AddShape(msoShapeOval, Sol, Üst, En, Boy)
Exit Function
Hata:
Set DaireNesne = Nothing
Exit Function

End Function
Public Function ÇizgiNesne(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Shape

On Error GoTo Hata
NoktaX1 = X1
If X2 >= NoktaX1 Then

NoktaX2 = X2

Else

NoktaX1 = X2
NoktaX2 = X1

End If
NoktaY1 = Y1
If Y2 >= NoktaY1 Then

NoktaY2 = Y2

Else

NoktaY1 = Y2
NoktaY2 = Y1

End If
Set ÇizgiNesne = SayfaTuval.Shapes.AddLine(X1, Y1, X2, Y2)
Exit Function
Hata:
Set ÇizgiNesne = Nothing
Exit Function

End Function
Public Property Set NesneTuvaliYap(Tuval As Object)

On Error GoTo Hata
Durum = False
Set NesneTuval = Tuval
NesneTuval.PictureSizeMode = fmPictureSizeModeClip
NesneTuval.PictureAlignment = fmPictureAlignmentTopLeft
Exit Property
Hata:
Set NesneTuval = Nothing
Exit Property

End Property
Public Property Set FormTuvaliYap(Ekran As MSForms.UserForm)

On Error GoTo Hata
Durum = True
Set FormTuval = Ekran
FormTuval.PictureSizeMode = fmPictureSizeModeClip
FormTuval.PictureAlignment = fmPictureAlignmentTopLeft
Exit Property
Hata:
Set FormTuvaliYap = Nothing
Exit Property

End Property
Public Sub NesneBoya()

On Error GoTo Hata
Set NesneÇerçeve = Çerçevele
ReDim Bellek(SayfaTuval.Shapes.Count - 1) As Variant
i = 0
For Each NesneÇerçeve In SayfaTuval.Shapes

Bellek(i) = NesneÇerçeve.Name
i = i + 1

Next
SayfaTuval.Shapes.Range(Bellek).Group
Set NesneÇerçeve = SayfaTuval.Shapes(1)
NesneÇerçeve.CopyPicture xlScreen, xlBitmap
If Durum Then

Set FormTuval.Picture = ResimGönder(xlBitmap)

Else

Set NesneTuval.Picture = ResimGönder(xlBitmap)

End If
Exit Sub
Hata:
Set NesneÇerçeve = Nothing
Set FormTuval.Picture = Nothing
Set NesneTuval.Picture = Nothing
Exit Sub

End Sub
Private Function Çerçevele() As Shape

On Error GoTo Hata
If Durum Then

If FormTuval.BackColor >= 0 Then

Tayf = FormTuval.BackColor

Else

Tayf = FormTuval.BackColor And &HFF
Tayf = GetSysColor(Tayf)

End If
Set Çerçevele = SayfaTuval.Shapes.AddShape(msoShapeRectangle, 0, 0, FormTuval.InsideWidth - 1, FormTuval.InsideHeight - 1)

Else

If NesneTuval.BackColor >= 0 Then

Tayf = NesneTuval.BackColor

Else

Tayf = NesneTuval.BackColor And &HFF
Tayf = GetSysColor(Tayf)

End If
Set Çerçevele = SayfaTuval.Shapes.AddShape(msoShapeRectangle, 0, 0, NesneTuval.Width - 1, NesneTuval.Height - 1)

End If
With Çerçevele

With .Fill

.ForeColor.RGB = Tayf
.BackColor.RGB = Tayf

End With
.Line.BackColor.RGB = Tayf
.Line.ForeColor.RGB = Tayf
.ZOrder msoSendToBack

End With
Exit Function
Hata:
Set Çerçevele = Nothing
Exit Function

End Function
Function ResimGönder(Optional ResimTipi As Long = xlPicture) As IPicture

EldekiResimTipi = IIf(ResimTipi = xlBitmap, 2, 14)
GeçerliResim = IsClipboardFormatAvailable(EldekiResimTipi)
If GeçerliResim <> 0 Then

Kontrol = OpenClipboard(0&)
If Kontrol > 0 Then

EldekiResim = GetClipboardData(EldekiResimTipi)
If EldekiResimTipi = 2 Then

Kopyalanan = CopyImage(EldekiResim, 0, 0, 0, &H4)

Else

Kopyalanan = CopyEnhMetaFile(EldekiResim, vbNullString)

End If
Kontrol = CloseClipboard
If EldekiResim <> 0 Then Set ResimGönder = ResimYap(Kopyalanan, 0, EldekiResimTipi)

End If

End If

End Function
Private Function ResimYap(ByVal Resim1 As Long, ByVal Eldeki As Long, ByVal EldekiResimTipi) As IPicture

On Error GoTo Hata
With Yamalamak

.Veri1 = &H7BF80980
.Veri2 = &HBF32
.Veri3 = &H101A
.Veri4(0) = &H8B: .Veri4(1) = &HBB: .Veri4(2) = &H0: .Veri4(3) = &HAA: .Veri4(4) = &H0: .Veri4(5) = &H30: .Veri4(6) = &HC: .Veri4(7) = &HAB

End With
With ResimBilgi

.Boyut = VBA.Len(Resim1)
.Tip = VBA.IIf(EldekiResimTipi = 2, 1, 4)
.Resim = Resim1
.Eldeki = VBA.IIf(EldekiResimTipi = 2, Eldeki, 0)

End With
Okunan = OleCreatePictureIndirect(ResimBilgi, Yamalamak, True, ResimNo)
Set ResimYap = ResimNo
Exit Function
Hata:
Set ResimYap = Nothing
Exit Function

End Function

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul