Datei wird in falschen ordner gespeicher
11.12.2020 14:47:01
Jonathan
ich habe folgendes Problem:
Ich möchte zu jeden Formulareintrag ein Ordner erstellen (Das funktioniert)
und in diesen Ordner dann die Zwischenablage kopieren. Leider funktioniert das nicht. Es wird immer in einem Ordner darüber gespeichert.
Sub screenshot()
Debug.Print lastID
Dim myChartObject As ChartObject, myShape As Shape
Dim bolfound As Boolean
Application.ScreenUpdating = False
Worksheets.Add
ActiveSheet.Paste
For Each myShape In ActiveSheet.Shapes
If myShape.Type = msoPicture Then bolfound = True: Exit For
Next
If bolfound Then
myShape.CopyPicture Appearance:=2, Format:=-4147
Set myChartObject = ActiveSheet.ChartObjects.Add(0, 0, myShape.Width, myShape.Height)
With myChartObject
.Activate
.Chart.Paste
.Chart.Export Filename:=ActiveWorkbook.Path & "\" & Bereich & "\" & lastID & "\Screenshot.jpg", FilterName:="JPG", Interactive:=False 'Das Bild wird nicht im LastID Ordner gespeichert, sondern im Bereich Ordner
End With
Set myChartObject = Nothing
Set myShape = Nothing
End If
With Application
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Private Sub CommandButton_Dateneingabe_Click()
'erste freie Zeile ausfindig machen
Dim last As Integer
last = Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim lastID As Integer
lastID = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If TextBox_Datum = "" Or TextBox_FAF = "" Or TextBox_FAF_Artikelnummer = "" Or ComboBox_AS = "" _
Or ComboBox_Fehler = "" Or TextBox_Fehlerbeschreibung = "" Then
MsgBox "Bitte zuerst alle Pflichtfelder ausfüllen"
Else
MkDir ActiveWorkbook.Path & "\" & Bereich & "\" & lastID
Call screenshot
ActiveWorkbook.Unprotect
Cells(last, 1).Value = lastID
'Datum
Cells(last, 2).Value = TextBox_Datum
'Ersteller
Cells(last, 3).Value = UserForm_User.ComboBox_Ersteller
'RMA
Cells(last, 4).Value = TextBox_RMA
'FAF -Nr
Cells(last, 5).Value = TextBox_FAF
'Artikel vom FAF
Cells(last, 6).Value = TextBox_
'SN
'Cells(last, 6).Value = TextBox_SN
'Arbeitsschritt
Cells(last, 9).Value = ComboBox_AS
'Fehlerkategorie
Cells(last, 10).Value = ComboBox_Fehler
'Kurzbeschreibung
Cells(last, 11).Value = TextBox_Fehlerbeschreibung
MsgBox "Daten sind in Tabelle eingetragen"
ActiveWorkbook.Save
End If
End Sub