title image


Smiley Re: Excelmappe erstellen, Foto aus Zwischenanlage einfügen und speichern
Hallo Ludwig,



ich hab mich mal an die Arbeit gemacht. Das Makro vom Rainer habe ich übernommen. Danke Rainer für die gute Vorarbeit :)

Anbei das Makro und ein Bildchen.



Viele Grüße

Herby







' Ein neues Modul anlegen und den Code in

' Modul1 kopieren



Option Explicit

Sub EinfuegenBild()

Dim newPicName As String, newPic As Object

Dim tarRange As Range, tarStart As Range

newPicName = Application.GetOpenFilename("Zulässige Bilder (*.jpg; *.gif; *.bmp), *.jpg, *.gif, *.bmp")

If newPicName = "Falsch" Then Exit Sub

If Not chkFileExt(newPicName) Then

MsgBox "Unerlaubter Dateityp", vbCritical + vbOKOnly, "Abbruch"

Exit Sub

End If

Application.ScreenUpdating = False

Set tarRange = Range("C2:F20")

Set newPic = ActiveSheet.Pictures.Insert(newPicName)

With newPic

.Top = tarRange.Top + 1

.Left = tarRange.Left + 1

.Width = tarRange.Width - 1

.Height = tarRange.Height - 1

End With

'tarRange.Value = newPic.Name

Set tarStart = Nothing

Set tarRange = Nothing

Application.ScreenUpdating = True

End Sub





Function chkFileExt(chkFile As String) As Boolean

Select Case UCase(Right(chkFile, 3))

Case "JPG", "BMP", "GIF"

chkFileExt = True

Case Else

chkFileExt = False

End Select

End Function





'Userform anlegen und den folgenden Code

'in Formulare/Userform1 kopieren





Option Explicit

Private Sub CommandButton1_Click()

Dim strDATEINAME As String

Dim strDATEINAME_ALT As String

strDATEINAME = ListBox1.Value

strDATEINAME_ALT = ActiveWorkbook.Name

Workbooks.Add

Call EinfuegenBild

ActiveWorkbook.SaveAs Filename:="C:\Kundenfotos\" & strDATEINAME & ".xls"

Workbooks(strDATEINAME & ".xls").Close SaveChanges:=True

Workbooks(strDATEINAME_ALT).Activate

UserForm1.Hide

End Sub



Private Sub UserForm_Initialize()

Dim a As Long

ListBox1.Clear

For a = 3 To Range("A65536").End(xlUp).Row

ListBox1.AddItem Cells(a, 1).Value

Next a

End Sub











geschrieben von

Anhang
Bild 11365 zu Artikel 538582

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: