Export Filenmae aus Worksheet
25.01.2018 08:48:40
Josi
ich habe ein Makro geschrieben welches mir ermöglicht ein Bild auszuwählen dies in einen Ordner zu kopieren und einen Hyperlink zu dem Bild in dem Ordner erstellt. Ich möchte jetzt das Bild nach einigen Parametern aus meinem Worksheet benennen, leider funktioniert das gar nicht! So wie es benannt werden soll ist es jetzt bei .Export Filename drin.
Sub BildHochladendirekteUrsache()
Dim Speicherordner As String
Dim Filename As String
Speicherordner = "W:\Dokumente\Format\20_Störungen\40_Digitale Liste offener Punkte dLOP\ _
10_Blistermaschine\" & "LOP " & Range("D5").Value & "-" & Range("B9").Value & "0" & Range("D9"). _
_
Value & "-" & Range("G9").Value
'Bild öffnen
Application.Dialogs(xlDialogInsertPicture).Show , arg1:="C:\TEMP"
'Ordner erstellen
If Dir(Speicherordner, vbDirectory) = "" Then
MkDir (Speicherordner)
'MsgBox "Ordner wurde angelegt!"
Else
'MsgBox "Ordner ist vorhanden!"
End If
'Bild einfügen
Dim myChart As Chart, myChartObject As ChartObject
Dim int_with As Integer, int_hight As Integer
Application.ScreenUpdating = True
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
int_with = Selection.Width - Selection.Width / 100 * 8
int_hight = Selection.Height - Selection.Height / 100 * 8
Set myChart = Charts.Add
Set myChartObject = ActiveChart.ChartObjects.Add(0, 0, int_with, int_hight)
With myChartObject.Chart
.Paste
'.Export Filename:=ActiveWorkbook.Path & "\zwischenablage.jpg", FilterName:="JPG", _
Ineractive:=False
.Export Filename:=Speicherordner & "\03_Bild direkte Ursache1.jpg" & "LOP " & Range("D5" _
_
_
).Value & "-" & Range("B9").Value & "0" & Range("D9").Value & "-" & Range("G9").Value, _
FilterName:="JPG", Interactive:=False
End With
Application.DisplayAlerts = False
myChart.Delete
Application.DisplayAlerts = True
Set myChart = Nothing
Set myChartObject = Nothing
Application.ScreenUpdating = True
' Hyperlink Makro
'ActiveCell.FormulaR1C1 = "Bild"
Range("D27").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Speicherordner & "\03_Bild direkte Ursache1.jpg" _
, TextToDisplay:="Bild direkte Ursache"
End Sub