Hallo wieder,
Mach dir eine Userform mit einer Textbox1 und einem Commandbutton1 und diesem darin:
Private Sub CommandButton1_Click()
If Datei_vorhanden(Me.TextBox1) = False Then Exit Sub
Call Bild_laden(ActiveSheet, Range("A1"), Me.TextBox1)
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Auswahl As String
Auswahl = Bild_auswahl
Me.TextBox1 = Auswahl
End Sub
und noch ein Modul mit diesem code:
Public Sub Bild_laden(WS As Worksheet, rng As Range, Pfad As String)
Dim Picture As Object
Application.ScreenUpdating = False
Set Picture = WS.Pictures.Insert(Pfad)
With Picture
.Top = rng.Top
.Left = rng.Left
End With
Application.ScreenUpdating = True
Call Maß(Picture, 200)
End Sub
Public Function Bild_auswahl() As String
Dim oFileDialog As FileDialog
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With oFileDialog
.Filters.Clear
.Filters.Add "Bilddateien", "*.jpg", 1
.Filters.Add "Bilddateien", "*.tif", 2
.Filters.Add "Bilddateien", "*.gif", 3
.Filters.Add "Bilddateien", "*.bmp", 4
.Filters.Add "Bilddateien", "*.png", 5
.Title = "Bitte wählen Sie ein Bild aus"
.ButtonName = "wählen"
.AllowMultiSelect = False
If .Show = -1 Then Bild_auswahl = .SelectedItems(1)
End With
End Function
Public Function Datei_vorhanden(Pfad As String) As Boolean
If Dir(Pfad, vbDirectory) = "" Then
Datei_vorhanden = False
Else
Datei_vorhanden = True
End If
End Function
Sub Maß(SH As Object, Optional Höhe As Double, Optional Breite As Double)
Dim V As Double
With SH
If .Height > .Width Then
V = .Height / .Width
If Höhe = 0 Then
.Width = Breite
.Height = Breite * V
Else
.Height = Höhe
.Width = Höhe / V
End If
Else
V = .Width / .Height
If Höhe = 0 Then
.Width = Breite
.Height = Breite / V
Else
.Height = Höhe
.Width = Höhe * V
End If
End If
End With
End Sub
|