PDA

Vollständige Version anzeigen : flexible Anzahl an String Variablen übergeben (paramarray)


ZD14-a
30.08.2017, 09:26
Hallo liebes Forum,

Ich habe ein Problem und ich denke, paramarray ist der Schlüssel zum Erfolg. Allerdings habe ich das nicht ganz durchblickt!

Folgende Aufgabenstellung:
Es gibt eine Userform, die in einer Listbox alle Tabellenblätter anzeigt. Nach einer Auswahl durch den User, werden die ausgewählten Blätter in eine neue Datei kopiert und diese temporär gespeichert und als Mailanhang verschickt. (Damit nicht immer unnötig viele Tabellenblätter, die den Empfänger nicht interessieren, verschickt werden)

Derzeit löse ich das über ein verstecktes Tabellenblatt (Hidden_VBA), welches am Anfang hinzugefügt und am Ende gelöscht wird. Grundsätzlich funktioniert das alles. Ich hätte aber gerne eine schönere Lösung.

Hier mein derzeitiger Code (habe alles mMn unwichtige weggelassen, z.B.: Mail öffnen):



Sub MailStart()

'Start sending a mail
Hidden_VBA 'erstellt das Tabellenblatt Hidden_VBA

frm_MailDialog.Show

End Sub

'Code in der Userform
Private Sub cmd_OpenMail_Click()

'Choose sheet
Sheets("Hidden_VBA").Range("A:A").Clear

Dim intListBox As Integer
Dim intAusgabe As Integer

For intListBox = 0 To frm_MailDialog.lst_Worksheets.ListCount - 1
If frm_MailDialog.lst_Worksheets.Selected(intListBox) Then
intAusgabe = intAusgabe + 1
Sheets("Hidden_VBA").Cells(intAusgabe, 1).Value = frm_MailDialog.lst_Worksheets.List(intListBox)
End If
Next intListBox

MailOpen

End Sub

Sub MailOpen()

'Copy data and open e-mail
Dim name As String
Dim Wst As String
Dim Count As Integer
Dim Quant As Integer

Application.ScreenUpdating = False

Dim QWB As Workbook
Dim ZWB As Workbook
Dim QWS As Worksheet
Dim ZWS As Worksheet

'open template
Set QWB = ActiveWorkbook
Workbooks.Open ("*PFAD*Mail_Template.xlsx")
Set ZWB = ActiveWorkbook

Quant = QWB.Sheets("Hidden_VBA").Range("B1").Value 'in B1 ist die Anzahl der Einträge
Count = 1

'Copy worksheets
For Count = 1 To Quant
Wst = QWB.Sheets("Hidden_VBA").Range("A" & Count).Value

Set QWS = QWB.Worksheets(Wst)
Set ZWS = ZWB.Worksheets.Add

With ZWS
.name = Wst
.Move After:=Sheets(Sheets.Count)
End With

'Tabellenblatt kopieren
Next Count

'Set Name
name = QWB.Sheets("Hidden_VBA").Range("A1").Value & "_"
For Count = 2 To Quant
name = name & QWB.Sheets("Hidden_VBA").Range("A" & Count).Value & "_"
Next Count
name = name & frm_MailDialog.txt_AddInfo.Value & ".xlsx"

'Delete the not used worksheet "Hidden_VBA"
Application.DisplayAlerts = False
QWB.Worksheets("Hidden_VBA").Delete
Application.DisplayAlerts = True


Application.ScreenUpdating = True

'Create Mail

frm_MailDialog.Hide

End Sub



Vielen Dank! :)

Beverly
30.08.2017, 10:03
Hi,

im Prinzip so:

Private Sub cmdCopy_Click()
Dim intTab As Integer
Dim arrTabs()
Dim intZaehler As Integer
ReDim arrTabs(1 To 1)
arrTabs(1) = ""
intZaehler = 1
For intTab = 1 To Me.ListBox1.ListCount
If Me.ListBox1.Selected(intTab - 1) Then
ReDim Preserve arrTabs(1 To intZaehler)
arrTabs(intZaehler) = Me.ListBox1.List(intTab - 1)
intZaehler = intZaehler + 1
End If
Next intTab
If arrTabs(1) <> "" Then Worksheets(arrTabs).Copy
Me.Hide
End Sub



<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

ZD14-a
30.08.2017, 12:09
Hallo Beverly,

Danke für deine schnelle Antwort!

Ich habe das jetzt mal ausprobiert. Allerdings bekomme ich die Fehlermeldung: "Laufzeitfehler '9': Index außerhalb des gültigen Bereichs" bei der Zeile: (beim ersten Auftritt dieser)

name = QWB.Sheets(arrTabs(Count)) & "_"

Ich habe auch mal Quant ausgelesen, das ist angeblich 0!
Quant = UBound(arrTabs())

Kannst du mir sagen, ob ich die arrTabs in der Userform richtig eingebunden habe? Ich glaube, es hakt an der Übergabe (das ist aber nur mein Bauchgefühl). Wie stelle ich das richtig? Ich habe jetzt nochmal ausprobiert, den Code von Mail_Open() gleich in die Userform zu kopieren. Das funktioniert aber auch nicht.


'Code in der Userform
Private Sub cmd_OpenMail_Click()

If frm_MailDialog.lst_Worksheets.ListIndex = -1 Then
MsgBox "Please choose at least one worksheet!", vbCritical + vbOKOnly, "Warning"
Exit Sub
End If

Dim intListBox As Integer 'Dim intTab As Integer
Dim intAusgabe As Integer 'Dim intZaehler As Integer
Dim arrTabs()
ReDim arrTabs(1 To 1)
arrTabs(1) = ""
intAusgabe = 1

For intListBox = 1 To frm_MailDialog.lst_Worksheets.ListCount
If frm_MailDialog.lst_Worksheets.Selected(intListBox - 1) Then
ReDim Preserve arrTabs(1 To intAusgabe)
arrTabs(intAusgabe) = frm_MailDialog.lst_Worksheets.List(intListBox - 1)
intAusgabe = intAusgabe + 1
End If
Next intListBox

MailOpen (arrTabs)

End Sub

Sub MailOpen(ParamArray arrTabs() As Variant)

'Copy data and open e-mail
Dim name As String
Dim Wst As String
Dim Count As Integer
Dim Quant As Integer
Dim QWB As Workbook
Dim ZWB As Workbook
Dim QWS As Worksheet
Dim ZWS As Worksheet

Application.ScreenUpdating = False

'open template
Set QWB = ActiveWorkbook
Workbooks.Open ("*Pfad*Mail_Template.xlsx")
Set ZWB = ActiveWorkbook

Quant = UBound(arrTabs())
Count = 1

'Copy worksheets
For Count = 1 To Quant
Wst = QWB.Sheets(arrTabs(Count))
Set QWS = QWB.Worksheets(Wst)
Set ZWS = ZWB.Worksheets.Add

With ZWS
.name = Wst
.Move After:=Sheets(Sheets.Count)
End With

'copy worksheets
Next Count

'Set Name
name = QWB.Sheets(arrTabs(Count)) & "_"
For Count = 2 To Quant
name = name & QWB.Sheets(arrTabs(Count)) & "_"
Next Count
name = name & frm_MailDialog.txt_AddInfo.Value & ".xlsx"

'Delete the not used worksheet "tralala"
Application.DisplayAlerts = False
ZWB.Worksheets("tralala").Delete
Application.DisplayAlerts = True

'Save workbook TEMP
ActiveWorkbook.SaveAs Filename:="C:Temp" & name
ActiveWorkbook.Close False

Application.ScreenUpdating = True

'Create Mail

frm_MailDialog.Hide

End Sub


Danke vielmals :)

Beverly
30.08.2017, 12:55
Hi,

ich habe meinen Code mal so geändert, dass das Array mit den Tabellen an eine Sub übergeben wird:

Private Sub cmdCopy_Click()
Dim intTab As Integer
Dim arrTabs()
Dim intZaehler As Integer
ReDim arrTabs(1 To 1)
arrTabs(1) = ""
intZaehler = 1
For intTab = 1 To Me.ListBox1.ListCount
If Me.ListBox1.Selected(intTab - 1) Then
ReDim Preserve arrTabs(1 To intZaehler)
arrTabs(intZaehler) = Me.ListBox1.List(intTab - 1)
intZaehler = intZaehler + 1
End If
Next intTab
If arrTabs(1) <> "" Then MailOpen arrTabs
Me.Hide
End Sub

Sub MailOpen(arrTabs())
Worksheets(arrTabs).Copy
End Sub



<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

ZD14-a
30.08.2017, 13:11
Du bist ja richtig flott!! Die Übergabe funktioniert jetzt.

Aber so ganz klappt das noch immer nicht. So wie ich das verstehe, sind in diesem Array immer Wertepaare gespeichert (0 - Tabelle1, 1 - Tabelle3, etc) Wobei eben nur die vorhin ausgewählten Tabellenblätter gespeichert werden. Genau darauf möchte ich mit der untenstehenden Zeile (oder ähnlichen) zugreifen.

Wst = QWB.Sheets(arrTabs(Count))

Da kommt der Fehler: "Laufzeitfehler '438': Objekt unterstützt diese Eigenschaft oder Methode nicht"

Zur Erinnerung: QWB ist als Workbook deklariert, Wst als String

Danke Danke :)

ZD14-a
30.08.2017, 13:33
Ich hab's!

Richtig ist:

wst=arrTabs(Count)

analog gilt das natürlich für alle anderen Zeilen auch!

Also hier nochmal der ganze Code:


Private Sub cmd_OpenMail_Click()

If frm_MailDialog.lst_Worksheets.ListIndex = -1 Then
MsgBox "Please choose at least one worksheet!", vbCritical + vbOKOnly, "Warning"
Exit Sub
End If

Dim intListBox As Integer
Dim intAusgabe As Integer
Dim arrTabs()
ReDim arrTabs(1 To 1)
arrTabs(1) = ""
intAusgabe = 1

For intListBox = 1 To frm_MailDialog.lst_Worksheets.ListCount
If frm_MailDialog.lst_Worksheets.Selected(intListBox - 1) Then
ReDim Preserve arrTabs(1 To intAusgabe)
arrTabs(intAusgabe) = frm_MailDialog.lst_Worksheets.List(intListBox - 1)
intAusgabe = intAusgabe + 1
End If
Next intListBox

MailOpen arrTabs

End Sub

Sub MailOpen(arrTabs())

'Copy data and open e-mail
Dim name As String
Dim Wst As String
Dim Count As Integer
Dim Quant As Integer
Dim QWB As Workbook
Dim ZWB As Workbook
Dim QWS As Worksheet
Dim ZWS As Worksheet

Application.ScreenUpdating = False

'open template
Set QWB = ActiveWorkbook
Workbooks.Open ("*PFAD*Mail_Template.xlsx") 'Template verschieben!
Set ZWB = ActiveWorkbook

Quant = UBound(arrTabs())
Count = 1

'Copy worksheets
For Count = 1 To Quant
Wst = arrTabs(Count)
Set QWS = QWB.Worksheets(Wst)
Set ZWS = ZWB.Worksheets.Add

With ZWS
.name = Wst
.Move After:=Sheets(Sheets.Count)
End With

QWS.Cells.Copy ZWS.Cells(1, 1)
With ZWS.Range("A1:EZ5000")
.Value = .Value
End With
Next Count

'Set Name
name = arrTabs(1) & "_"
For Count = 2 To Quant
name = name & arrTabs(Count) & "_"
Next Count
name = name & frm_MailDialog.txt_AddInfo.Value & ".xlsx"

'Delete the not used worksheets "tralala"
Application.DisplayAlerts = False
ZWB.Worksheets("tralala").Delete
Application.DisplayAlerts = True

'Save workbook TEMP

Application.ScreenUpdating = True

'Create Mail

End Sub