Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
784to788
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
784to788
784to788
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Blattschutz durch Makro kurzfristig aufheben

Blattschutz durch Makro kurzfristig aufheben
20.07.2006 15:30:59
Peter
Hallo,
habe mit folgendem Problem zu kämpfen:
Möchte aus einer geschlossenen Datei (Zahlen.xls) Daten in die
aktive Datei übertragen. Das klappt mit dem u.g. Makro auch sehr
gut. Wenn ich das aktive Tabellenblatt aber mit Blattschutz versehe,
funktioniert das Makro nicht mehr. Möchte daher den Blattschutz kurzfristig
ausschalten. Kriege das aber leider nicht so geregelt. Vielleicht kann mir
ja jemand behilflich sein?!?
Option Explicit

Sub Zahlen_uebertragen()
Dim objWb As Workbook
Dim objSh As Worksheet
Dim strFile As String
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
strFile = "F:\Daten\Zahlen.xls"
If Not ThisWorkbook Is ActiveWorkbook Then ThisWorkbook.Activate
Set objSh = ActiveSheet
Set objWb = Workbooks.Open(strFile)
objWb.Sheets(5).Range("A1:M100").Copy objSh.Range("A2")
objWb.Close False
ErrExit:
If Err.Number > 0 Then
MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
Err.Clear
End If
Set objWb = Nothing
Set objSh = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Blattschutz durch Makro kurzfristig aufheben
20.07.2006 15:36:28
Hoffi
Hallo,
So müsste es gehn (ungetestet):
Option Explicit

Sub Zahlen_uebertragen()
Dim objWb As Workbook
Dim objSh As Worksheet
Dim strFile As String
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
strFile = "F:\Daten\Zahlen.xls"
If Not ThisWorkbook Is ActiveWorkbook Then ThisWorkbook.Activate
Set objSh = ActiveSheet
Set objWb = Workbooks.Open(strFile)
objSh.Unprotect Password:="Test"
objWb.Sheets(5).Range("A1:M100").Copy objSh.Range("A2")
objSh.Protect Password:="Test"
objWb.Close False
ErrExit:
If Err.Number > 0 Then
MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
Err.Clear
End If
Set objWb = Nothing
Set objSh = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
End Sub

Grüße
Hoffi
P.S. Rückmeldung wäre nett...
Anzeige
AW: Vielen Dank!!!
20.07.2006 15:42:48
Peter
Hey, super und vielen Dank Hoffi!
Makro läuft jetzt problemlos!
Danke für die schnelle Hilfe!!!
AW: Danke für die Rückmeldung o.T.
20.07.2006 15:51:15
Hoffi
:-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige