AW: Problem Projekt o. Bibliothek Excel 2007
14.07.2010 07:53:37
94WID43NAU
Guten Morgen Hajo. Hier der Code für das Modul. Unter Excel 2003 läuft es ohne Probleme. Ich weiss leider nicht, woran es unter Excel 2007 hardert. Vielen Dank für deine Unterstützung.
Private Sub AuslastungPivotTab_Click()
Dim strA As String
Dim strO As String
Dim strFileName As String
Dim strVerzeichniss As String
Dim lngLaufvariabel As Long
On Error GoTo ErrHandler
Application.ScreenUpdating = False
strA = Cells(3, Anfang + 7).Address(False, False)
strO = Cells(256, Ende + 7).Address(False, False)
ActiveSheet.Range("A3:H256," & strA & ":" & strO & ",CA3:CZ256").Select
Application.CutCopyMode = False
Selection.Copy
strVerzeichniss = ActiveWorkbook.Path & "\"
Select Case PlanPer
Case 1
'Windows("AuslastungPivot1.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot1.xls"
Case 2
'Windows("AuslastungPivot2.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot2.xls"
Case 3
'Windows("AuslastungPivot3.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot3.xls"
Case 4
'Windows("AuslastungPivot4.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot4.xls"
Case 5
'Windows("AuslastungPivot5.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot5.xls"
Case 6
'Windows("AuslastungPivot6.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot6.xls"
Case 7
'Windows("AuslastungPivot7.xls").Activate
strFileName = strVerzeichniss & "AuslastungPivot7.xls"
End Select
Workbooks.Open strFileName
Sheets("Pivot").Select
'Do ... Loop Until:
lngLaufvariabel = 5
Do
lngLaufvariabel = lngLaufvariabel + 1
Loop Until ActiveSheet.Cells(lngLaufvariabel, 3) = ""
ActiveSheet.Cells(lngLaufvariabel, 3).Select
ActiveSheet.Paste
lngLaufvariabel = 0
With Worksheets("Pivot")
lngLaufvariabel = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, _
Rows.Count)
If langLaufvariabel = 1000 Then
UserName = 1
.Range(.Cells(2, 1), .Cells(1000, 2)).Clear
End If
Do
Cells(lngLaufvariabel + 1, 1).Value = Environ("Username") 'USER ID
Cells(lngLaufvariabel + 1, 2).Value = Date ' Date ohne Uhrzeit; "Now" mit Uhrzeit
lngLaufvariabel = lngLaufvariabel + 1
Loop Until .Cells(lngLaufvariabel + 1, 3) = ""
End With
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
MsgBox "Daten wurden übertragen"
Sheets("IPS Termine").Select
ErrHandler:
If Err.Number = 1004 Then
MsgBox "Bitte zuerst eine Periode auswählen!"
ElseIf Err.Number > 2 Then
MsgBox "Unbekannter Fehler: " & Err.Number
End If
Range("A3:IV65500").ClearContents '
Dim WorkbookBeforeClose As Boolean
a = MsgBox("Wollen Sie das Programm beenden?", _
vbYesNo)
If a = vbYes Then
Workbooks("Auslastung_KO.xls").Close False
End If
End Sub