'entwickelt von Winfried Radner 'e-mail: Wolf.W.Radzinski@onlinehome.de 'Benutzung frei - ohne Gewähr Funktionen des AddIn (ALT!) "scrollarea2.xla" ... inkl. Erweiterung (NEU!) ---> "scrollarea2a.xla" WENN dieses AddIn geladen ist kann man die Scrollarea wie folgt beeinflussen (einfach die AddInFunktionen wie beschrieben irgendwo in den eigenen Code einfügen und aufrufen) 1) Run "scrollarea2.xla!resetSA",b,string_1,string_2,string_3,...,string_N oder (abhängig vom Namen des geladenen AddIns!) Run "scrollarea2a.xla!resetSA",b,string_1,string_2,string_3,...,string_N hiermit definiert man für Blatt 1 bis N die ScrollAreaPARAMETER (UND aktiviert bzw. setzt die ScrollArea des aktiven Blattes i auf den Wert string_i) DIE AKTIVIERUNG WURDE ENTFERNT, da sie mit setSA bzw setSAi erreicht werden kann s.u. resetSA OHNE Parameter dahinter löscht alle zuvor definierten Strings Ist der Parameter b auf TRUE gesetzt, dann werden die Strings nicht gelöscht, bevor sie NEU definiert werden (alte zuvor gesetzte Strings bleiben so teilweise erhalten) Fehlt Parameter b oder ist auf FALSE gesetzt, dann wird vorher ein Cells.Clear im AddIn durchgeführt string_k KANN jetzt auch folgendermaßen gesetzt werden Run "scrollarea2a.xla!resetSA",b,"k:=" & string_k es sind maximal 65536 unterschiedliche Strings möglich 2) Run "scrollarea2a.xla!setSA" hiermit wird die ScrollArea des AKTIVEN Blattes i auf string_i gesetzt bzw aktiviert 3) will man dies nicht (da man z.B. mehr Blätter als Parameter hat) bzw. will man den Parameter des aktiven Blattes i ändern ruft man Run "scrollarea2a.xla!setSAi", j auf, damit wird die ScrollArea des Aktiven Blattes i auf string_j gesetzt 4) Run "scrollarea2a.xla!tempNoSA" setzt die ScrollArea des aktiven Blattes i wechselweise auf "" bzw. string_i d.h. die ScrollArea wird temporär aus- und wieder eingeschaltet das AddIn kann unter http://www.rendar.de/excel runtergeladen werden der Filename ist "SCROLLAREA2a.XLA" 5) weitere Mögliche Übergabeparameter bei resetSA an die Stringvariablen sind z.B. selection selection.address currentregion activewindow.visiblerange.address etc ... z.B. in einem eigenen Modul folgendes eintragen (und natürlich das AddIn laden!) Sub sSA() Run "scrollarea2a.xla!resetSA", , Selection Run "scrollarea2a.xla!scrRight" 'nur in der erweiterten Version! Run "scrollarea2a.xla!setSAi", 1 End Sub einen Bereich markieren und das eigene Makro sSA aufrufen und die aktuelle Selection ist zur ScrollArea im aktiven Blatt geworden! Selection ist so natürlich zum einzigen definierten Parameter geworden, alle zuvor eventuell existierenden Strings wurden gelöscht. 6) in der Erweiterung zusätzlich eingebaut mit Run "scrollarea2a.xla!ScrollDirection", bzw. Run "scrollarea2a.xla!scrRight" Run "scrollarea2a.xla!scrLeft" Run "scrollarea2a.xla!scrUp" Run "scrollarea2a.xla!scrDown" wird die Scrollrichtung ebenfalls per VBA Aufruf eingestellt ============================================================ es folgt der VBA Code des AddIn's scrollarea2a.xla NICHT UNBEDINGT IN DER AKTUELLSTEN VERSION! Aber ich denke ausreichend, um die Funktionsweise zu erkennen ============================================================ 1) resetSA löscht/ersetzt/definiert die Stringparameter, die zur Definition der ScrollArea benutzt werden können und sie SETZT die ScrollArea des aktiven Blattes (NOCH, evtl werd ich das aber wieder entfernen, da man durch zusätzlichen Aufruf von setSA die gleiche Wirkung erzielt! ---> CODE WURDE ENTFERNT! zusätzlicher Aufruf von setSA bzw setSAi jetzt zwingend erforderlich!) -- Die Anzahl der Übergabeparameter ist nicht fest vorgegeben -- Der ERSTE Parameter in der Liste dient dazu, zu entscheiden, ob alte Stringparameter gelöscht werden oder nicht -- Alle weiteren Parameter sollten vom Format String sein und einen Zellbereich definieren Public Sub resetSA(ParamArray pa() As Variant) On Error Resume Next löscht Zellen im Arbeitsblatt des AddIn, wenn NICHT auf TRUE gesetzt! If pa(0) <> True Then ThisWorkbook.Sheets(1).Cells.Clear ParamAnzahl = UBound(pa()) Hier werden die einzelnen Strings definiert und entweder anhand ihrer Position geordnet oder gezielt mittels z.B. "4:=A:B" ... damit wird mit Index 4 als ScrollArea die Spalten A und B definiert For i = 1 To ParamAnzahl If InStr(1, pa(i), ":=") > 0 Then ix = CLng(Left(pa(i), InStr(1, pa(i), ":=") - 1)) sx = Right(pa(i), Len(pa(i)) - InStr(1, pa(i), ":=") - 1) ThisWorkbook.Sheets(1).Cells(ix, 1) = sx Else ThisWorkbook.Sheets(1).Cells(i, 1) = pa(i) End If Next i Hier WURDE (!!!) die ScrollArea des aktiven Blattes gesetzt ' ASh = ActiveSheet.Index ' Sheets(ASh).ScrollArea = ThisWorkbook.Sheets(1).Cells(ASh, 1) End Sub Hiermit wird ebenfalls die ScrollArea des aktiven Blattes gesetzt und zwar auf den String, dessen Index mit dem des Blattes übereinstimmt Public Sub setSA() On Error GoTo err_hndl ASh = ActiveSheet.Index Sheets(ASh).ScrollArea = ThisWorkbook.Sheets(1).Cells(ASh, 1) Exit Sub err_hndl: ActiveSheet.ScrollArea = "" End Sub Hiermit wird die ScrollArea des aktiven Blattes x auf den String i gesetzt d.h. die Anzahl der definierten Strings muß nicht zwingend mit der Anzahl der Arbeitsblätter in der Mappe übereinstimmen! Public Sub setSAi(i As Long) On Error GoTo err_hndl ASh = ActiveSheet.Index Sheets(ASh).ScrollArea = ThisWorkbook.Sheets(1).Cells(i, 1) Exit Sub err_hndl: ActiveSheet.ScrollArea = "" End Sub Hiermit kann die gesetzte ScrollArea des aktiven Blattes temporär abgeschaltet und bei erneutem Aufruf wieder gesetzt werden Public Sub tempNoSA() On Error Resume Next Dim temp As String If ActiveSheet.ScrollArea <> "" Then ThisWorkbook.Sheets(1).Cells(1, 2) = ActiveSheet.ScrollArea ActiveSheet.ScrollArea = "" Else ActiveSheet.ScrollArea = ThisWorkbook.Sheets(1).Cells(1, 2) ThisWorkbook.Sheets(1).Cells(1, 2) = "" End If End Sub '################################### '# Erweiterung!!! '################################### '# '# enthält zusätzlich Funktionen '# zur Steuerung des Cursors '# '################################### Public Sub ScrollDirection(d As String) Select Case UCase(d) Case "R", "RIGHT", "RECHTS": Application.MoveAfterReturnDirection = xlToRight Case "D", "DOWN", "UNTEN": Application.MoveAfterReturnDirection = xlDown Case "U", "O", "UP", "OBEN": Application.MoveAfterReturnDirection = xlUp Case "L", "LEFT", "LINKS": Application.MoveAfterReturnDirection = xlToLeft Case Else: End Select End Sub Public Sub scrRight() ScrollDirection "R" End Sub Public Sub scrLeft() ScrollDirection "L" End Sub Public Sub scrUp() ScrollDirection "U" End Sub Public Sub scrDown() ScrollDirection "D" End Sub WER KEIN AddIn will kopiert den Code in ein Modul seiner Wahl, erzeugt in der Mappe ein weiteres Arbeitsblatt (z.B. "SADefs") und ersetzt im obigen Code jedes "Sheets(1)" durch "Sheets("SADefs")"