'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",<Stringargument>
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

<code>
Public Sub resetSA(ParamArray pa() As Variant)
On Error Resume Next
</code>

löscht Zellen im Arbeitsblatt des AddIn, wenn NICHT auf TRUE gesetzt!

<code>
  If pa(0) <> True Then ThisWorkbook.Sheets(1).Cells.Clear
  ParamAnzahl = UBound(pa())
</code>

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

<code>
  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
</code> 

Hier WURDE (!!!) die ScrollArea des aktiven Blattes gesetzt

<code 2 Zeilen entfernt!!!>
 ' ASh = ActiveSheet.Index
 ' Sheets(ASh).ScrollArea = ThisWorkbook.Sheets(1).Cells(ASh, 1)
End Sub
</code>


Hiermit wird ebenfalls die ScrollArea des aktiven Blattes gesetzt
und zwar auf den String, dessen Index mit dem des Blattes übereinstimmt

<code>
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
</code>

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!

<code>
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
</code>

Hiermit kann die gesetzte ScrollArea des aktiven Blattes temporär abgeschaltet
und bei erneutem Aufruf wieder gesetzt werden

<code>
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
</code>

'###################################
'#    Erweiterung!!!
'###################################
'#
'# enthält zusätzlich Funktionen
'# zur Steuerung des Cursors
'#
'###################################

<code>
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
</code>




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")"