eventuell geht das ja doch
Reinhard
Hi Norbert,
mal als Ansatz, keine Ahnung ob das mit 8.0 geht, mit 9.0 gings.
Die Datei: https://www.herber.de/bbs/user/13209.xls enthält nachfolgenden Code.
Man bewegt die Maus und je nach Position wird eine Zelle gefärbt. Anstatt der Färbung kann man *annehm* auch die Schriftgöße erhöhen oder die Zelle als Bild umwandeln und vergrößern.
Die Zuordnung von Position des Cursors und der Zellposition stimmt noch nicht, sieht aber lösbar aus.
Vielleicht schaut ja noch mal jemand mit gutem VBA-Wissen über die Codes.
Gestartet wird es übern den CommandButton von Tablle1.
Gruß
Reinhard
Man beachte die Verweise im ganz untenstehenden VB-Code
In ein StandardModul:
Dim Xwert As Long
Dim Ywert As Long
Dim XYzelle As String
Private Declare Function GetCursorPos Lib "user32" (lpPoint As _
POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Sub position()
Dim Result&, P As POINTAPI
Result = GetCursorPos(P)
If Xwert <> P.x Or Ywert <> P.y Then Zelle = Range(Adr(P.x, P.y)).Address
If XYzelle = "" Then XYzelle = "$A$1"
If Zelle = "" Then Zelle = "$A$1"
If XYzelle <> Zelle Then
Range(Zelle).Interior.ColorIndex = 3
Range(XYzelle).Interior.ColorIndex = xlNone
XYzelle = Zelle
End If
End Sub
Function Adr(x As Long, y As Long) As String
For n = 1 To 30 '10 zeilen
gg = Cells(n, 1).Top
If Cells(n, 1).Top + 103 >= y Then
zeile = n
[E1] = zeile
Exit For
End If
Next n
For n = 1 To 124 '4 Spalten
g = Cells(1, n).Left
If Cells(1, n).Left + 28 >= x Then
spalte = n
[F1] = spalte
Exit For
End If
Next n
Adr = Cells(zeile, spalte).Address
End Function
In den Codeteil von Tabelle1:
Private Sub CommandButton1_Click()
For n = 1 To 1000
Start = Timer
Call position
While Start + 1 > Timer
Wend
Next n
End Sub
Entwickelt habe dich das Ganze aus diesem VB-Beispiel:
'Dieser Source stammt von <a href="http://www.activevb.de">http://www.activevb.de</a>
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.
'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!
'------------- Anfang Projektdatei Project1.vbp -------------
' Es muss ein Verweis auf 'Standard OLE Types' gesetzt werden.
' Es muss ein Verweis auf 'Microsoft DAO 3.0 Object Library' gesetzt
' werden.
'--------- Anfang Formular "Form1" alias Form1.Frm ---------
' Steuerelement: Timersteuerelement "Timer1"
Option Explicit
Private Declare Function GetCursorPos Lib "user32" (lpPoint As _
POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub Timer1_Timer()
Dim Result&, P As POINTAPI
Result = GetCursorPos(P)
Me.Caption = "X: " & P.x & " Y: " & P.y
End Sub
'---------- Ende Formular "Form1" alias Form1.Frm ----------
'-------------- Ende Projektdatei Project1.vbp -----