Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1624to1628
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
Inhaltsverzeichnis

Worksheet-Name aus geschlossener Mappe lesen

Worksheet-Name aus geschlossener Mappe lesen
27.05.2018 18:06:02
Graf
Hallo zusammen,
leider bin ich auch nach ein paar Stunden Internet-Rechereche nicht weitergekommen.
Ich habe folgendes Problem:
In einer ComboBox sollen die Namen der Tabellenblätter aus einer geschlossen Arbeitsmappe (Fahrzeughandlingsliste_neu) zur Auswahl stehen.
Wenn in der geöffneten Arbeitsmappe das ganze verfasse: Kein Problem

Sub UserForm_Initialize()
Dim Liste(8) As Variant
Dim n As Integer
Dim m As Integer
m = 2
For n = 0 To 8
Liste(n) = Workbooks("Fahrzeughandlingsliste_neu.xlsm").Worksheets(m).Name
m = m + 1
Next n
Me.ComboBox1.List = Liste
End Sub

Jetzt möchte ich aber eigentlich eine neue Mappe erstellen, in der nur die Auswahl stattfindet und die Name aus der geschlossenen Datei ausgelesen werden...
Hat mir jemand einen Tipp?
Natürlich zieht sich das Problem weiter und wird um eine weitere Schwierigkeit ergänzt..
In Abhängigkeit davon, was der Nutzer aus der Liste auswählt, muss aus der wünschenswert geschlossenen Datei "Fahrzeughandlingsliste_neu" ein Bereich in die neue Auswahl-Mappe kopiert werden(für jede Tabelle der gleiche Auswahl- und Zielbereich)
Bisher habe ich nur diesen recht stümperhaften und nicht sehr flexibelen Weg gefunden...
Private

Sub ComboBox1_Click()
Select Case ComboBox1.Value
Case Workbooks("Fahrzeughandlingsliste_neu.xlsm").Worksheets(1).Name
Workbooks("Fahrzeughandlingsliste_neu.xlsm").Worksheets(1).Range("B13:R37").Copy  _
Destination:=Range("B13:R37")
Weiter muss ich das ja dann auch für die neun anderen Tabellenblätter machen.. Jemand Ideen? Vielen Dank für Eure Hilfe!! :)

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet-Name aus geschlossener Mappe lesen
27.05.2018 18:40:17
Sepp
Hallo Graf,
die Tabellennamen erhälsz du so.
Dialog UserForm1
Option Explicit 
 
Private Sub UserForm_Initialize() 
Dim varList As Variant, strFile As String 
 
strFile = "D:\Forum\Test.xlsx"  'Dateiname - ANPASSEN! 
 
varList = GetSheetNames(strFile) 
 
If IsArray(varList) Then ComboBox1.List = varList 
 
End Sub 
 
Private Function GetSheetNames(ByVal FileName As String) As Variant 
  'original by Bob Phillips, adapted by j.ehrensberger 
  Dim objADO As Object, objCAT As Object, objTAB As Object 
  Dim lngI As Long, intL As Integer, intP As Integer, intS As Integer 
  Dim strCon As String, strTab As String 
  Dim vntTmp() As Variant 
 
  If Mid(FileName, InStrRev(FileName, ".") + 1) = "xls" Then 
    strCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Extended Properties=Excel 8.0;" & _
      "Data Source=" & FileName & ";" 
  ElseIf Mid(FileName, InStrRev(FileName, ".") + 1) Like "xls?" Then 
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0;HDR=YES"";" _
      & "Data Source=" & FileName & ";" 
  Else 
    Exit Function 
  End If 
 
  Set objADO = CreateObject("ADODB.Connection") 
  objADO.Open strCon 
  Set objCAT = CreateObject("ADOX.Catalog") 
  Set objCAT.ActiveConnection = objADO 
 
  For Each objTAB In objCAT.Tables 
    strTab = objTAB.Name 
    intL = Len(strTab) 
    intP = 0 
    intS = 1 
    'Worksheet name with embedded spaces enclosed by single quotes 
    If Left(strTab, 1) = "'" And Right(strTab, 1) = "'" Then 
      intP = 1 
      intS = 2 
    End If 
    'Worksheet names always end in the "$" character 
    If Mid$(strTab, intL - intP, 1) = "$" Then 
      Redim Preserve vntTmp(lngI) 
      vntTmp(lngI) = Mid$(strTab, intS, intL - (intS + intP)) 
      lngI = lngI + 1 
    End If 
  Next objTAB 
 
  If lngI > 0 Then GetSheetNames = vntTmp 
 
  objADO.Close 
  Set objCAT = Nothing 
  Set objADO = Nothing 
End Function 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

TypNameEigenschaften
ComboBoxComboBox1
Height:18
Left:12
Top:21
Width:114

Aus einer geschlossenen Datei kannst du nichts kopieren.
du könntest aber per VBA eine Formel in den Bereich eintragen und den Tabellennamen je nach Auswahl anpassen.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Worksheet-Name aus geschlossener Mappe lesen
27.05.2018 18:56:20
Sepp
Hallo nochmal,
mit der Formel z.B. so.
Dialog UserForm1
Option Explicit 
 
Const cstrFile As String = "D:\Forum\Test.xlsx" 'Dateiname - ANPASSEN! 
 
Private Sub ComboBox1_Change() 
Dim strPath As String, strFile As String, strTab As String, strRef As String 
 
strFile = Mid(cstrFile, InStrRev(cstrFile, "\") + 1) & "]" 
strPath = "='" & Left(cstrFile, InStrRev(cstrFile, "\")) & "[" 
strTab = ComboBox1.Text & "'!" 
strRef = "B13" 
 
Range("B13:R37").Formula = strPath & strFile & strTab & strRef 
End Sub 
 
Private Sub UserForm_Initialize() 
Dim varList As Variant 
 
varList = GetSheetNames(cstrFile) 
 
If IsArray(varList) Then ComboBox1.List = varList 
 
End Sub 
 
Private Function GetSheetNames(ByVal FileName As String) As Variant 
  'original by Bob Phillips, adapted by j.ehrensberger 
  Dim objADO As Object, objCAT As Object, objTAB As Object 
  Dim lngI As Long, intL As Integer, intP As Integer, intS As Integer 
  Dim strCon As String, strTab As String 
  Dim vntTmp() As Variant 
 
  If Mid(FileName, InStrRev(FileName, ".") + 1) = "xls" Then 
    strCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Extended Properties=Excel 8.0;" & _
      "Data Source=" & FileName & ";" 
  ElseIf Mid(FileName, InStrRev(FileName, ".") + 1) Like "xls?" Then 
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0;HDR=YES"";" _
      & "Data Source=" & FileName & ";" 
  Else 
    Exit Function 
  End If 
 
  Set objADO = CreateObject("ADODB.Connection") 
  objADO.Open strCon 
  Set objCAT = CreateObject("ADOX.Catalog") 
  Set objCAT.ActiveConnection = objADO 
 
  For Each objTAB In objCAT.Tables 
    strTab = objTAB.Name 
    intL = Len(strTab) 
    intP = 0 
    intS = 1 
    'Worksheet name with embedded spaces enclosed by single quotes 
    If Left(strTab, 1) = "'" And Right(strTab, 1) = "'" Then 
      intP = 1 
      intS = 2 
    End If 
    'Worksheet names always end in the "$" character 
    If Mid$(strTab, intL - intP, 1) = "$" Then 
      Redim Preserve vntTmp(lngI) 
      vntTmp(lngI) = Mid$(strTab, intS, intL - (intS + intP)) 
      lngI = lngI + 1 
    End If 
  Next objTAB 
 
  If lngI > 0 Then GetSheetNames = vntTmp 
 
  objADO.Close 
  Set objCAT = Nothing 
  Set objADO = Nothing 
End Function 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

TypNameEigenschaften
ComboBoxComboBox1
Height:18
Left:12
Top:21
Width:114

 ABCDEF
1Gruß Sepp
2
3

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige