Type Anweisung
26.07.2019 08:57:42
Marvin
ich habe folgendes Problem. Ich habe einen eigenen Type deklariert und eine Funktion in einem Modul geschrieben, wo mir unter einer bestimmten Bedingung worksheets raus geschrieben werden. Mein definierter Typ soll sich dabei aus dem Namen des Worksheets und der Position, wo es sich in der Arbeitsmappe befindet, zusammensetzen. Das Klappt soweit auch ganz gut. [Code 1].
Jetzt möchte ich diese Funktion in einem anderen Sub aufrufen und mir nur den Namen der Worksheets per Drop Down anzeigen lassen. [Code 2] Hier ist mein Problem. Ich bekomme die die Variable, die als mein Type definiert wurde, nicht in mein anderes Sub und dann auch nicht nur den Namen der worksheets. Ich hoffe ihr konntet mein Problem verstehen.
Hier meine Codes:
Code 1:
'##########################################################'
'Define own Type fpr Projectsheets array'
'##########################################################'
Public Type Projecttyp
Name As String
Selected As Boolean
Index As String
End Type
'##########################################################'
'Compare all Worksheet Names with a defined Cellname. If the Worksheet Name is like the Name in _ the defined Cell then put all Sheets in one Array'
Public Function Projectarray() As String
Dim wsName() As Projecttyp
Dim Sheetname As String
Dim Cellname As String
Dim i, j As Integer
Dim Compare As Integer
'Workbook.Open
'Compare Name from all Worksheets with Cellname in defined Cell'
For i = 1 To ThisWorkbook.Worksheets.Count
Sheetname = Sheets(i).Name
Cellname = Sheets(i).Range("D2")
Compare = InStr(1, Cellname, Sheetname, vbTextCompare)
'All Names from Worksheets which are like the Name in the defined Cell are listed in array _
wsName()'
If Compare > 0 Then
j = j + 1
ReDim wsName(1 To j) As Projecttyp
With wsName(j)
.Name = Sheets(i).Name
.Index = i
End With
'List the different Elements for Projecttyp in Cells'
Cells(j, 1) = wsName(j).Name
Cells(j, 2) = wsName(j).Index
End If
Next i
End Function
Code 2:
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rend, Rstart As Integer
Dim DDName As String
Dim j As Integer
Application.ScreenUpdating = False
Call Projectarray
Rstart = 5
Rend = Rstart + 200
'#####################################################
'Hier sollen meine Namen aufgelistet werden für die Drop Down liste aus dem Code 1
'###########################################################
DDName = Join(wsName().Name, ",")
If Intersect(Target, Range("B" & Rstart & " :B" & Rend)) Is Nothing Then Exit Sub
With ActiveCell
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlGreater, Formula1:=DDName
.Validation.IgnoreBlank = True
.Validation.InCellDropdown = True
.Validation.ShowInput = True
End With