華府江山
http://203.72.56.8/phpBB3/

show image in VBA
http://203.72.56.8/phpBB3/viewtopic.php?f=21&t=943
1 頁 (共 1 頁)

發表人:  alex [ 2012年 12月 17日, 20:51 ]
文章主題 :  show image in VBA

Sub Macro1()

ActiveSheet.Pictures.Insert ("C:\mypicture.jpg")

End Sub
=============================================
Sub TestInsertPicture()
InsertPicture "C:\FolderName\PictureFileName.gif", _
Range("D10"), True, True
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub
====================================================
Sub TestInsertPictureInRange()
InsertPictureInRange "C:\FolderName\PictureFileName.gif", _
Range("B5:D10")
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub
=========================================

1 頁 (共 1 頁) 所有顯示的時間為 UTC + 8 小時
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/