ein lieber Freund von mir hat mir geholfen einen VBA Code zu schreiben, der Zeilen ausblendet und wieder einblendet. Jetzt möchte ich genau das Selbe auch mit einem anderen Knopf machen. Ich habe das ganze einfach kopiert und jetzt scheint auf, "Fehler beim Komprimieren - Mehrdeutiger Name". Dies kommt beim zweiten mal Sub Anzeigen () vor. Ich hoffe es kann mir da jemand weiterhelfen. (Ich habe da jetzt einfach alles hineinkopiert).
Private Sub ToggleButton1_Click()
Dim objWb As Workbook
Dim a As Variant
Dim objShp As Shape
Const WBName As String = "Preise.xls" 'Name der Datei mit der Preisliste
Const TBName As String = "Tabelle1" 'Name des Tabellenblattes in WBName
'On Error GoTo ErrExit'
GMS
With ThisWorkbook.Sheets("Daten") 'Tabellenname anpassen
If Application.CountA(.Range("E28:X127")) = 0 Then
ToggleButton1.Caption = "Ausblenden"
'objShp.DrawingObject.Text = "Ausblenden" '
For Each objWb In Application.Workbooks
If objWb.Name = WBName Then Exit For
Next
If objWb Is Nothing Then
Set objWb = Workbooks.Open(ThisWorkbook.Path & "\" & WBName)
End If
a = objWb.Sheets(TBName).Range("E26:X125")
objWb.Close False
.Range("E28:X127") = a
Else
ToggleButton1.Caption = "Anzeigen"
.Range("E28:X127").ClearContents
End If
End With
ErrExit:
Set objShp = Nothing
Set objWb = Nothing
GMS True
'Set xlMappe = GetObject(WBName)
'Dim WorkS As Worksheet
'WorkS = xlMappe.Worksheets(Tabelle1)
'a = WorkS.Range("E26:X125")
'Range("E28:X127") = a
End Sub
Sub Anzeigen()
End Sub
Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Modus Then
.Calculation = IIf(lngCalc 0, lngCalc, xlCalculationAutomatic)
Else
lngCalc = .Calculation
.Calculation = xlCalculationManual
End If
.Cursor = IIf(Modus, -4143, 2)
.CutCopyMode = False
End With
End Sub
Private Sub ToggleButton2_Click()
Dim objWb As Workbook
Dim a As Variant
Dim objShp As Shape
Const WBName As String = "Preise.xls" 'Name der Datei mit der Preisliste
Const TBName As String = "Tabelle1" 'Name des Tabellenblattes in WBName
'On Error GoTo ErrExit'
GMS
With ThisWorkbook.Sheets("Daten") 'Tabellenname anpassen
If Application.CountA(.Range("E28:X127")) = 0 Then
ToggleButton1.Caption = "Ausblenden"
'objShp.DrawingObject.Text = "Ausblenden" '
For Each objWb In Application.Workbooks
If objWb.Name = WBName Then Exit For
Next
If objWb Is Nothing Then
Set objWb = Workbooks.Open(ThisWorkbook.Path & "\" & WBName)
End If
a = objWb.Sheets(TBName).Range("E26:X125")
objWb.Close False
.Range("E28:X127") = a
Else
ToggleButton1.Caption = "Anzeigen"
.Range("E28:X127").ClearContents
End If
End With
ErrExit:
Set objShp = Nothing
Set objWb = Nothing
GMS True
'Set xlMappe = GetObject(WBName)
'Dim WorkS As Worksheet
'WorkS = xlMappe.Worksheets(Tabelle1)
'a = WorkS.Range("E26:X125")
'Range("E28:X127") = a
End Sub
Sub Anzeigen()
End Sub
Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Modus Then
.Calculation = IIf(lngCalc 0, lngCalc, xlCalculationAutomatic)
Else
lngCalc = .Calculation
.Calculation = xlCalculationManual
End If
.Cursor = IIf(Modus, -4143, 2)
.CutCopyMode = False
End With
End Sub
lg aus dem weihnachtlichen Innsbruck
Patricia.