Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 16:50:59
2 Zellen in 2 Blättern mit unterschiedlichen Bereichen vergl
25.04.2024 15:03:35
Unterschiedliche Dateien miteinander abgleichen lassen
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
860to864
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

860to864: Nach Ablauf d. Makros Scrollbalken verschoben

Nach Ablauf d. Makros Scrollbalken verschoben
12.04.2007 22:33:53
Thomas

Hallo,
wenn ich beispielsweise an einer gewissen Position in einem Tabellenblatt bin und ein bestimmtes Makro durchführen lasse, bin ich nach Ablauf dessen immer ganz oben mit meinem Bildausschnitt (Scrollbalken ganz oben obwohl er vorher wo anders war). Dies möchte ich nicht, ich möchte nach Ablauf des Makros den Srollbalken/Bildausschnit genau an der Position haben, den vor dem Start des Makros hatte.
Wie realisier ich das ??
Bitte um jeden Hinweis - Danke !
Grüße
Thomas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nach Ablauf d. Makros Scrollbalken verschoben
12.04.2007 23:03:22
Horst
Hi,
ohne deinen Code kann man nur raten, verzichte auf select/activate.
mfg Horst
AW: Nach Ablauf d. Makros Scrollbalken verschoben
12.04.2007 23:51:49
Thomas
Dim geoffnet As Variant
Set geoffnet = ActiveWorkbook
vorhanden = False
For Prüfprotokoll = 1 To sheets.Count
If sheets(Prüfprotokoll).Name = "Prüfprotokoll" Then
sheets(Prüfprotokoll).Select
vorhanden = True
Exit For
End If
Next Prüfprotokoll
If vorhanden Then
GoTo Tabelle_einrichten
Else
Workbooks("Makro_Fotoblatt_Protokoll.xls").sheets("Prüfprotokoll").Copy after:=geoffnet.sheets(3)
End If
geoffnet.Activate
Tabelle_einrichten:
' Fotoblatt Belag einrichten
sheets("Fotoblatt Belag").Select
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Range("A1:H25").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
' Tabelle 3 einrichten
' Fotoblatt Bremsscheibe einrichten
sheets("Fotoblatt Bremsscheibe").Select
Columns("A:A").Select
Selection.ColumnWidth = 50
Range("A1:A5").Select
With Selection.Font
.Name = "Arial"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Rows("1:1").Select
Selection.RowHeight = 12.5
Rows("5:5").Select
Selection.RowHeight = 12.5
Range("A1:A5").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Daten aus Verschleiß auslesen
sheets("Verschleiß").Select
neuVersuch = ActiveCell.Offset(1, 1).Range("A1")
Set neuVersuch = ActiveCell.Offset(1, 1).Range("A1")
neuVersuchNr = ActiveCell.Offset(3, 1).Range("A1")
Set neuVersuchNr = ActiveCell.Offset(3, 1).Range("A1")
neuVersuchNr = "Vers.: " & (neuVersuchNr)
neuBelagNr = ActiveCell.Offset(5, 12).Range("A1")
Set neuBelagNr = ActiveCell.Offset(5, 12).Range("A1")
neuBelag1Nr = ActiveCell.Offset(5, 13).Range("A1")
Set neuBelag1Nr = ActiveCell.Offset(5, 13).Range("A1")
ActiveWindow.ScrollRow = 1
neuSchNr = Range("A2")
Set neuSchNr = Range("A2")
neuSchNr = "'" & (neuSchNr)
neuBrBelag = Range("R2")
Set neuBrBelag = Range("R2")
neuBrBelag = "Belag: " & (neuBrBelag)
chargeBe = ActiveCell.Offset(5, 10).Range("A1")
Set chargeBe = ActiveCell.Offset(5, 10).Range("A1")
Belag1 = ActiveCell.Offset(13, 2).Range("A1")
Set Belag1 = ActiveCell.Offset(13, 2).Range("A1")
Belag2 = ActiveCell.Offset(13, 3).Range("A1")
Set Belag2 = ActiveCell.Offset(13, 3).Range("A1")
Charge = ActiveCell.Offset(5, 10).Range("A1")
Set Charge = ActiveCell.Offset(5, 10).Range("A1")
prueBelag = Range("R2")
Set prueBelag = Range("R2")
prueVersNr = ActiveCell.Offset(3, 1).Range("A1")
Set prueVersNr = ActiveCell.Offset(3, 1).Range("A1")
BSNr = Range("A2")
Set BSNr = Range("A2")
'Daten in Fotoblatt Belag einfügen
sheets("Fotoblatt Belag").Range("A11") = neuVersuch
sheets("Fotoblatt Belag").Range("E10") = neuVersuchNr
sheets("Fotoblatt Belag").Range("H9") = neuBelagNr
sheets("Fotoblatt Belag").Range("H12") = neuBelag1Nr
sheets("Fotoblatt Belag").Range("A10") = neuSchNr
sheets("Fotoblatt Belag").Range("E11") = neuBrBelag
'Daten in Fotoblatt Bremsscheibe einfügen
sheets("Fotoblatt Bremsscheibe").Range("A2") = neuSchNr
sheets("Fotoblatt Bremsscheibe").Range("A3") = neuVersuchNr
sheets("Fotoblatt Bremsscheibe").Range("A4") = neuVersuch
'Daten in Prüfprotokoll einfügen
sheets("Prüfprotokoll").Range("B16") = prueVersNr
sheets("Prüfprotokoll").Range("B17") = BSNr
sheets("Prüfprotokoll").Range("B18") = prueBelag
sheets("Prüfprotokoll").Range("B19") = neuVersuch
sheets("Prüfprotokoll").Range("C29") = Belag1
sheets("Prüfprotokoll").Range("D29") = Belag2
sheets("Prüfprotokoll").Range("F29") = Belag1
sheets("Prüfprotokoll").Range("G29") = Belag2
sheets("Prüfprotokoll").Range("D39") = Charge
sheets("Prüfprotokoll").Range("f16") = DateTime.Date
' Schrift_zentrieren
sheets("Fotoblatt Bremsscheibe").Select
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Blätter drucken
sheets("Fotoblatt Belag").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:= _
True
sheets("Fotoblatt Bremsscheibe").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:= _
True
sheets("Prüfprotokoll").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:= _
True
sheets("Verschleiß").Select
'
' Makroblatt schließen
'
Windows("Makro_Fotoblatt_Protokoll.xls").Activate
ActiveWindow.Close
End Sub
Anzeige
AW: Nach Ablauf d. Makros Scrollbalken verschoben
13.04.2007 10:11:52
Rudi Maintaire
Hallo,
wie Horst schon schrieb: Verzichte auf Select und Activate.
Codeschnipsel: 
Tabelle_einrichten:
' Fotoblatt Belag einrichten
With Sheets("Fotoblatt Belag")
With .PageSetup
.PrintArea = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
With .Range("A1:H25").Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Bold = True
End With
End With
' Tabelle 3 einrichten
' Fotoblatt Bremsscheibe einrichten
With Sheets("Fotoblatt Bremsscheibe")
.Columns("A:A").ColumnWidth = 50
.Rows("1:1").RowHeight = 12.5
.Rows("5:5").RowHeight = 12.5
With .Range("A1:A5")
With .Font
.Name = "Arial"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Bold = True
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End With

Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige