MSGBox Speichern einpflegen?
02.07.2017 10:31:58
Andreas
Hallo,
nun habe ich das Makro lauffähig- macht alles wie es soll.
Könnte man aber am Ende der Prozedur noch eine MSG Box einpflegen, die mich fragt, ob die Änderungen in der Mappe Filename:="D:\ProtokollnR1.xlsm" auch gespeichert werden sollen, ja? Nein?
Nein würde bedeuten: Änderungen in ProtokollnR1.xlsm nicht speichern, Datei ProtokollnR1.xlsm schließen, und zurück zum Blatt Windows("Vorlage ortsveraenderliche .xlsm")- diese Änderungen dort können bestehen bleiben.
Zur Zeit läuft es ohne Nachfrage- es wird gespeichert und geschlossen.
Ist dies möglich und wo müsste was im Code eingeplegt werden?
Option Explicit
Sub Auto_Nr_Verg()
Workbooks.Open Filename:="D:\ProtokollnR1.xlsm"
' Nr und Ort automatisch in Protokollliste
Application.CutCopyMode = False 'Zwischenspeicher löschen
Dim Zeile As Long
Zeile = Range("O65536").End(xlUp).Row
MsgBox "Letzter Eintrag ist in Zeile Nr. " & Zeile
Windows("Vorlage ortsveraenderliche .xlsm").Activate
Range("AC28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ProtokollnR1.xlsm").Activate
Application.GoTo Range("O65536").End(xlUp).Offset(1, 0)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.GoTo Range("O65536").End(xlUp).Offset(0, -1)
Application.CutCopyMode = False
Selection.Copy
Windows("Vorlage ortsveraenderliche .xlsm").Activate
Range("Y35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W35:Z35").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Windows("ProtokollnR1.xlsm").Activate
Application.GoTo Range("O65536").End(xlUp).Offset(1, -1)
Application.CutCopyMode = False 'Zwischenspeicher löschen
ActiveWorkbook.Close True
End Sub
LG Andreas
Anzeige