08.02.2011

Namen - RefersTo - RefersTo Range - auslesen!

Frage: In Tabellenblättern ist einer Zelle oder einem Range ein Name zugeordnet. Auf einem neuen Tabellenblatt sollen nun die Werte der Namen und die Zugehörigkeit ausgegeben werden:

Namen - RefersTo - RefersTo Range - auslesen...[ZIP, 50 KB]

Code gehört in ein allgemeines Modul:
Option Explicit
Public Sub Eine_Zelle()
Dim blnFrage As Boolean
Dim intCount As Integer
Dim nmName As Name
On Error GoTo Fin
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Worksheets.Add After:=Sheets(Sheets.Count)
For Each nmName In ThisWorkbook.Names
If LCase(nmName.Name) Like "*nettopreis" Then
With ActiveSheet
.Cells(intCount + 1, 1).Value = _
nmName.RefersToRange.Text
.Cells(intCount + 1, 2).Value = _
nmName.RefersTo
.Cells(intCount + 1, 3).Value = _
nmName.Name
intCount = intCount + 1
blnFrage = True
End With
End If
Next nmName
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
If Not blnFrage Then ActiveSheet.Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Public Sub Einen_Range()
Dim blnFrage As Boolean
Dim intCount As Integer
Dim intTMP As Integer
Dim nmName As Name
On Error GoTo Fin
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Worksheets.Add After:=Sheets(Sheets.Count)
For Each nmName In ThisWorkbook.Names
If LCase(nmName.Name) Like "*netto*" Then
If nmName.RefersToRange.Count > 1 Then
For intTMP = 1 To nmName.RefersToRange.Count
With ActiveSheet
.Cells(intCount + 1, 1).Value = _
nmName.RefersToRange.Cells _
(intTMP).Value
.Cells(intCount + 1, 2).Value = _
nmName.RefersTo
.Cells(intCount + 1, 3).Value = _
nmName.Name
intCount = intCount + 1
blnFrage = True
End With
Next intTMP
Else
With ActiveSheet
.Cells(intCount + 1, 1).Value = _
nmName.RefersToRange.Text
.Cells(intCount + 1, 2).Value = _
nmName.RefersTo
.Cells(intCount + 1, 3).Value = _
nmName.Name
intCount = intCount + 1
blnFrage = True
End With
End If
End If
Next nmName
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
If Not blnFrage Then ActiveSheet.Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Keine Kommentare:

Kommentar veröffentlichen

Word - Kontrollkästchen (Formularsteuerelement) auslesen...

Aus allen Worddateien sollen die Kontrollkästchen (Formularsteuerelement) ausgelesen werden - Haken gesetzt oder nicht. Auch ein Textfeld (F...