On Thu, 1 Feb 2001 11:15:36 +0100, "Anders Kaas Petersen"
<akp@dematic.dk> wrote:
>
>Er det muligt at indsætte grafik (firma-logo) i sidehovedet i Excel 97??
Nedenstående VB rutine blev postet i dk.edb.regneark, men jeg har dog
ikke selv afprøvet det.
Sette inn bilder
Ved hjelp av makroene nedenfor kan du sette inn bilder i et angitt
område på
et regneark.
Sub TestInsertPicture()
InsertPicture "C:\FolderName\PictureFileName.gif", Range("D10"),
True,
True
InsertPictureInRange "C:\FolderName\PictureFileName.gif",
Range("B5:D10")
End Sub
Sub InsertPicture(PictureFileName As String, TargetCell As Range,
CenterH As
Boolean, CenterV As Boolean)
' setter inn et bilde plassert ved det øverste venstre hjørnet til
TargetCell
' bildet kan eventuelt sentreres horisontalt og/eller vertikalt
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 InsertPictureInRange(PictureFileName As String, TargetCells As
Range)
' setter inn et bilde fra en fil og endrer størrelsen slik at det
passer inn
i området TargetCells
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