AW: Screenshot in Datei speichern
11.12.2020 13:19:37
Jonathan
Entschuldige, hatte deine Frage falsch verstanden. Ich weiß nicht ob dir der gesamte Code nicht ein bisschen viel ist. In Worten ganz kurz:
Das Makro wird mit UF_User gestartet. In einer Combobox wird ein Ersteller gewählt. TBUser = der Wert aus der Combobox, und wird auch in der UF1 angezeigt.
UF1:
Sub Bild_exportieren()
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 & "\" & TBuser & "\zwischenablage.jpg", FilterName:="JPG", Interactive:=False
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 cbtn_Screenshot_Click()
Call Bild_exportieren
End Sub
Private Sub cbtn_zurück_Click()
Unload UserForm1
sAS = ""
sFehler = ""
UserForm_User.Show
End Sub
Private Sub CommandButton_Abrechen_Click()
Unload UserForm1
Unload UserForm_User
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
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
Private Sub Label_FAF_Artikelnummer_Click()
End Sub
Private Sub Label1_Click()
End Sub
Private Sub TextBox_FAF_exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBox_FAF) 9 Then
Cancel = True
MsgBox "Bitte richtige FAF-Nr. eingeben"
End If
End Sub
Private Sub TextBox_Datum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With TextBox_Datum
If Not IsDate(.Text) Then
MsgBox "Keine gültige Eingabe!"
'.Text = "Date only!"
'.SelStart = 0
'.SelLength = .TextLength
Cancel = True
End If
End With
End Sub
Private Sub UserForm_activate()
TBuser = UserForm_User.ComboBox_Ersteller
With Worksheets("Listen-Werte")
'ComboBox_AS.RowSource = sAS 'Auflistung Arbeitsschritte
ComboBox_Fehler.RowSource = sFehler
End With
End Sub
Private Sub UserForm_Initialize()
TBuser = UserForm_User.ComboBox_Ersteller
ComboBox_AS.RowSource = sAS 'Auflistung Arbeitsschritte
ComboBox_AS.ListRows = 25
UserForm1.TextBox_Datum = Date
End Sub
Private Sub UserForm_Terminate()
Unload UserForm_User
End Sub
UF_user
Private Sub cbtn_Click()
Unload UserForm1
UserForm1.Show
End Sub
Private Sub ComboBox_Ersteller_Click()
UserForm_User.Hide
UserForm1.Show
End Sub
Private Sub Obtn_VF_UV50_Change()
If Obtn_VF_UV50 Then Call changeLists(Obtn_VF_UV50)
End Sub
Private Sub Obtn_HP_Change()
If Obtn_HP Then Call changeLists(Obtn_HP)
End Sub
Private Sub Obtn_MOPA_Change()
If Obtn_MOPA Then Call changeLists(Obtn_MOPA)
End Sub
Private Sub Obtn_Q_Change()
If Obtn_Q Then Call changeLists(Obtn_Q)
End Sub
Private Sub Obtn_chip_Change()
If Obtn_Chip Then Call changeLists(Obtn_Chip)
End Sub
Private Sub Obtn_VF_CW100_Change()
If Obtn_VF_CW100 Then Call changeLists(Obtn_VF_CW100)
End Sub
Private Sub Obtn_CW100_Change()
If Obtn_CW100 Then Call changeLists(Obtn_CW100)
End Sub
Private Sub Obtn_VF_CW500_Change()
If Obtn_VF_CW500 Then Call changeLists(Obtn_VF_CW500)
End Sub
Private Sub Obtn_CW500_Change()
If Obtn_CW500 Then Call changeLists(Obtn_CW500)
End Sub
Private Sub Obtn_GB_Change()
If Obtn_GB Then Call changeLists(Obtn_GB)
End Sub
Private Sub UserForm_activate()
ComboBox_Ersteller.RowSource = Worksheets("Listen-Werte").Range("MA_GB").Address(external:=True) _
End Sub
Sub changeLists(obtn As Control)
sersteller = ""
sAS = ""
sFehler = ""
ComboBox_Ersteller.RowSource = ""
Select Case obtn.Caption
Case "VF-UV50"
sersteller = "MA_VF_UV50"
sAS = "AS_VF"
sFehler = "Fehler_VF_UV50"
Worksheets("VF_UV50").Activate
Case "HP"
sersteller = "MA_HP"
sAS = "AS_EF_UV50"
sFehler = "Fehler_EF_UV50"
Worksheets("hp").Activate
Case "MOPA"
sersteller = "MA_MOPA"
sAS = "AS_EF_UV50"
sFehler = "Fehler_EF_UV50"
Worksheets("MOPA").Activate
Case "Q"
sersteller = "MA_Q"
sAS = "AS_EF_UV50"
sFehler = "Fehler_EF_UV50"
Worksheets("Q").Activate
Case "Chipmessplatz"
sersteller = "MA_Chip"
sAS = "AS_Chip"
sFehler = "Fehler_Chip"
Worksheets("Chip").Activate
Case "VF-CW-100/ Intracavity"
sersteller = "MA_VF_CW100"
sAS = "AS_VF_CW100"
sFehler = "Fehler_VF_CW100"
Worksheets("VF_CW100").Activate
Case "CW-100/ Intracavity"
sersteller = "MA_CW100"
sAS = "AS_EF_CW100"
sFehler = "Fehler_EF_CW100"
Worksheets("CW100").Activate
Case "VF-CW-500"
sersteller = "MA_VF_CW500"
sAS = "AS_VF_CW500"
sFehler = "Fehler_VF_CW500"
Worksheets("VF_CW500").Activate
Case "CW-500"
sersteller = "MA_CW500"
sAS = "AS_EF_CW500"
sFehler = "Fehler_EF_CW500"
Worksheets("cw500").Activate
Case "GB"
sersteller = "MA_GB"
sAS = "AS_GB"
sFehler = "Fehler_GB"
Worksheets("GB").Activate
Case Else
End Select
ComboBox_Ersteller.RowSource = sersteller 'Liste neubefüllen
ComboBox_Ersteller.ListIndex = -1
Debug.Print sAS
End Sub