|
So sieht mein Code aus
Option Explicit
Dim m_appExcel As Excel.Application
Dim m_wbkExcel As Excel.Workbook
Dim m_strDateiExcel, pfad As String
Const m_cstrZellbereich = "(Zellbereich)"
'
Private Sub btnAbbrechen_Click()
Unload Me 'schließt den Dialog komplett
'Me.Hide
End Sub
Private Sub btnDateiExcel_Click()
Dim varDatei As Variant
If m_appExcel Is Nothing Then
Set m_appExcel = HoleExcel()
End If
varDatei = m_appExcel.GetOpenFilename("Excel-Arbeitsmappen,*.xls?,Alle Excel-Dateien,*.xl*", 2, _
"Bitte Datenquelle auswählen")
If varDatei <> False Then
m_strDateiExcel = varDatei
End If
DateiPruefen
End Sub
Private Sub btnMarkierenAlle_Click()
Markieren True
End Sub
Private Sub btnMarkierenKeine_Click()
Markieren False
End Sub
Private Sub Markieren(booWie As Boolean)
Dim intI As Integer
With Me.lstBereichsnamen
For intI = 0 To .ListCount - 1
.Selected(intI) = booWie
Next
End With
End Sub
Private Sub btnOK_Click()
Dim intI As Integer
Me.Hide
With Me.lstBereichsnamen
For intI = 0 To .ListCount - 1
If .Selected(intI) Then
If .Column(2, intI) = m_cstrZellbereich Then
m_appExcel.GoTo m_appExcel.Names(.Column(0, intI)).RefersToRange
m_appExcel.Selection.Copy
InTextmarkeEinfuegen .Column(0, intI)
Else
TextmarkenText(.Column(0, intI)) = .Column(2, intI)
End If
End If
Next
End With
Unload Me
'Me.Hide
End Sub
Private Sub lstBereichsnamen_Change()
Dim intI As Integer
Me.btnOk.Enabled = False
With Me.lstBereichsnamen
For intI = 0 To .ListCount - 1
If .Selected(intI) Then
Me.btnOk.Enabled = True
Exit For
End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
LadeDateinamenExcel
m_strDateiExcel = pfad
DateiPruefen
End Sub
Private Sub DateiPruefen()
With Me.lblDateiExcel
.Caption = "Daten aus " & pfad & " importieren:"
.ForeColor = vbBlack
FindeBereichsnamen
End With
End Sub
Private Sub FindeBereichsnamen()
Dim namExcel As Excel.Name
Dim strAdresse As String
Set m_appExcel = HoleExcel()
If m_appExcel Is Nothing Then
Exit Sub
End If
m_appExcel.Visible = True
Set m_wbkExcel = m_appExcel.Workbooks.Open(pfad, False, True)
With Me.lstBereichsnamen
For Each namExcel In m_appExcel.Names
If ActiveDocument.Bookmarks.Exists(namExcel.NameLocal) Then
On Error Resume Next
strAdresse = ""
strAdresse = namExcel.RefersToRange.AddressLocal
On Error GoTo 0
If strAdresse <> "" Then
.AddItem namExcel.NameLocal
.Column(1, .ListCount - 1) = strAdresse
If namExcel.RefersToRange.Cells.Count > 1 Then
.Column(2, .ListCount - 1) = m_cstrZellbereich
Else
.Column(2, .ListCount - 1) = Format(namExcel.RefersToRange.Value, _
namExcel.RefersToRange.NumberFormat)
End If
.Column(3, .ListCount - 1) = TextmarkenText(namExcel.NameLocal)
End If
End If
Next
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If m_wbkExcel Is Nothing Then
'also nicht geöffnet, nix tun
Else
m_wbkExcel.Close False
End If
End Sub
Sub LadeDateinamenExcel()
Dim appExcel As Excel.Application
Dim varDatei As Variant
Set appExcel = HoleExcel()
varDatei = appExcel.GetOpenFilename("Excel-Arbeitsmappen,*.xls?,Alle Excel-Dateien,*.xl*", 2, _
"Bitte Datenquelle auswählen")
If varDatei = False Then
MsgBox "Abgebrochen..."
Else
pfad = varDatei
MsgBox "Ausgewählt: " & varDatei
End If
End Sub
Das ist nur ein Teil der Code, wo die Textmarker aktualisiert werden, bzw übernommen werden. Das Einfügen von Code ist in eine andere Dialog.
|