Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
788to792
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hyperlink

Hyperlink
14.08.2006 12:24:22
Eisnic
Hallo,
ich habe ein kleines Problemchen :o( Vielleicht kann mir jemand weiterhelfen...hier die Problematik:
Ich habe eine Excel-Datei mit vorerst 1 Tabellenblatt. In diesem Tabellenblatt stehen in Zeile 2 diverse Zahlen, welche die Länge der Zellen festlegen sollen. Diese Länge wird in einem Makro geprüft. Überschreitet eine Zelle die vorgegebene Länge, wird dieses Feld gelb markiert, ein zweites Tabellenblatt angelegt und die Fehlermeldung dort ausgegeben. Mein Problem ist nun, dass ich gerne fuer jede Fehlermeldung einen Hyperlink erstellen moechte, der einen in das fehlerhafte Feld in Tabellenblatt 1 fuehrt. Der Code, den ich bisher habe, sieht folgendermassen aus:

Sub laenge_pruefen()
Dim lZeile As Long
Dim iSpalte As Integer
Rows(2).NumberFormat = "0"
Rows(2).Value = Rows(2).Value
For iSpalte = 1 To Range("IV2").End(xlToLeft).Column
For lZeile = 6 To Range("A65536").End(xlUp).Row
If Len(Cells(lZeile, iSpalte)) > Cells(2, iSpalte).Value Then Cells(lZeile, iSpalte).Interior.ColorIndex = 6
Next lZeile
Next iSpalte
Dim c As Range, wks As Worksheet
For Each wks In Worksheets
If wks.Name = "Prüfungen" Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next
For Each c In Sheets("Satzaufbau").UsedRange
If c.Interior.ColorIndex = 6 Then
On Error Resume Next
Set wks = Sheets("Pruefungen")
On Error GoTo 0
If wks Is Nothing Then
Set wks = Worksheets.Add
wks.Name = "Prüfungen"
wks.Move After:=Sheets(4)
End If
wks.Range("A65536").End(xlUp).Offset(1, 0).Value = "Feld " & c.Address & " ist zu lang"
End If
Next c
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink
14.08.2006 13:20:42
Josef
Hallo ?
Probier's so.
Sub laenge_pruefen()
Dim lngRow As Long, lngNext As Long
Dim intCol As Integer
Dim rng As Range, wks As Worksheet

For Each wks In Worksheets
  If wks.Name = "Prüfungen" Then
    wks.Cells.Clear
    Set wks = wks
    Exit For
  End If
Next

If wks Is Nothing Then
  Set wks = Worksheets.Add
  wks.Name = "Prüfungen"
  wks.Move After:=Sheets(Sheets.Count)
End If

With Sheets("Satzaufbau")
  .Rows(2).NumberFormat = "0"
  .Rows(2).Value = Rows(2).Value
  For intCol = 1 To .Range("IV2").End(xlToLeft).Column
    For lngRow = 6 To .Range("A65536").End(xlUp).Row
      If Len(.Cells(lngRow, intCol)) > .Cells(2, intCol).Value Then
        .Cells(lngRow, intCol).Interior.ColorIndex = 6
        lngNext = lngNext + 1
        wks.Cells(lngNext, 1).Value = _
          "Feld " & .Cells(lngRow, intCol).Address & " ist zu lang"
        
        wks.Hyperlinks.Add Anchor:=wks.Cells(lngNext, 1), _
          Address:="", _
          SubAddress:="'" & .Name & "'!" & .Cells(lngRow, intCol).Address(0, 0)
      End If
    Next
  Next
End With

End Sub


Gruß Sepp

Anzeige
AW: Hyperlink
14.08.2006 13:24:38
Eisnic
Hey Klasse...funktioniert einwandfrei...herzlichen Dank...da waere ich niemals drauf gekommen.
Gruss Eisnic
AW: Hyperlink
14.08.2006 13:24:28
u_
Hallo,
With wks.Range("A65536").End(xlUp).Offset(1, 0)
.Value = "Feld " & c.Address & " ist zu lang"
.Hyperlinks.Add wks.Range("A65536").End(xlUp), "#Satzaufbau!" & c.Address
End With
Gruß
Lesen gefährdet die Dummheit

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige