Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1336to1340
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1336to1340
1336to1340
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Textfeld mit Spalte vergleichen etc

Textfeld mit Spalte vergleichen etc
18.11.2013 15:16:44
Kina
Hallo zusammen,
Ich möchte folgendes machen:
In meinem Formular frmNewContact soll der Name des Kontaktes im Textfeld txtContact mit den Kontakten in der Tabelle/Lasche Kontakte mit den Werten in der Spalte A verglichen werden. Stimmt der Wert überein soll die entsprechende Zelle angeklickt werden und der darin enthaltene Hyperlink soll mich ins Exel Kontaktx.xlms führen wo in der Lasche Contacts die restlichen Werte des Formulars in der Spalte 9 eingetragen werden sollen.
So weit bin ich gekommen, könnt ihr mir mit dem Rest helfen? Bin totale Anfängerin...
Dim rng As Range
'Spalte A nach wert durchsuchen
Set rng = Sheets("Metafile").Range("A:A").Find(What:=txtClient.Text, Lookat:=xlWhole, LookIn:=xlValues)
'Wenn wert entdeckt
Find = True
ActiveSheet.Cell.Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveSheet.Sheets("Contacts").Select
Rows("9:9").Select
Selection.Insert Shift:=xlDown
ActiveSheet.Range("B9").Value = Me.txtXY.Value
ActiveSheet.Range("C9").Value = Me.cbbXY.Value
ActiveSheet.Range("D9").Value = Me.cbbXY.Value
ActiveSheet.Range("E9").Value = Me.txtXY.Value

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textfeld mit Spalte vergleichen etc
19.11.2013 07:40:47
fcs
Hallo Kina,
leider hast du vergessen, zu schreiben welcher Rest dir noch fehlt.
Ich hab mal ein wenig ins Blaue geraten.
Gruß
Franz 
Private Sub CommandButton1_Click()
Dim find As Boolean
Dim rng As Range
Dim wkbKontakt As Workbook, wksKontakt As Worksheet
On Error GoTo Fehler
'Spalte A nach wert durchsuchen
Set rng = Sheets("Metafile").Range("A:A").find(What:=txtClient.Text, _
Lookat:=xlWhole, LookIn:=xlValues)
'Wenn wert entdeckt
If rng Is Nothing Then
find = False
MsgBox "Kontakt """ & txtClient.Text & """ nicht gefunden"
Else
find = True
If rng.Hyperlinks.Count > 0 Then
Application.EnableEvents = False
rng.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Set wkbKontakt = ActiveWorkbook
Set wksKontakt = wkbKontakt.Sheets("Contacts")
wksKontakt.Rows("9:9").Insert Shift:=xlDown
With Me.txtA
If Value  "" Then wksKontakt.Range("B9").Value = Me.txtA.Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("C9").Value = Me.cbbXX.Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("D9").Value = Me.cbbXY.Value
End With
With Me.txtB
If Value  "" Then wksKontakt.Range("E9").Value = Me.txtB.Value
End With
wkbKontakt.Save
wkbKontakt.Close
Application.EnableEvents = True
Else
MsgBox "Zum Klienten """ & txtClient.Text & """ gibt es keinen Hyperlink"
End If
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case -2147221014
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Datei """ & rng.Hyperlinks(1).Address & """ zum Hyperlink  existiert nicht"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.EnableEvents = True
End Sub

Anzeige
AW: Textfeld mit Spalte vergleichen etc
19.11.2013 09:31:42
Kina
Lieber Franz,
Vielen Dank!!! Es funktioniert teilweise... über den Hyperlink wird das richtige Kontaktdossier geöffnet aber dann geht es nicht weiter... Es ist jedes Mal ein anderes Excel workbook das geöffnet wird, aber es heisst immer wie der Text im Textfeld txtClient.Text (also txtClient.Text.xlms) Habe folgendes versucht:
Set wkbtxtClient.Text = ActiveWorkbook
Set wkstxtClient.Text = wkbtxtClient.Text.Sheets("Contacts")
wksContact.Rows("9:9").Insert Shift:=xlDown
With Me.txtA
If Value "" Then wksContact.Text.Range("B9").Value = Me.txtA.Value
End With
With Me.cbbB
If .ListIndex -1 Then wksContact.Text.Range("C9").Value = Me.cbbB.Value
End With
With Me.cbbC
If .ListIndex -1 Then wksContact.Text.Range("D9").Value = Me.cbbC.Value
End With
With Me.txtS
If Value "" Then wksContact.Text.Range("E9").Value = Me.txtS.Value
End With
wkbtxtClient.Text.Save
wkbtxtClient.Text.Close
Kriege "Fehler Nr:9 Index ausserhalb des gültigen Bereichs"
Funktioniert leider nicht... Hast Du eine Idee?

Anzeige
AW: Textfeld mit Spalte vergleichen etc
19.11.2013 11:15:57
Kina
:-)

AW: Textfeld mit Spalte vergleichen etc
19.11.2013 11:18:32
fcs
Hallo Kina,
was ist denn denn bei dir ein Kontaktdossier? Ein Ordner in einem Verzeichnis oder eine Datei/Programm?
Was passiert, wenn du auf den Hyperlink eines Klienten klicks?
Wenn es ein Verzeichnis ist, dann sollte folgende Anpassung funktionieren.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim find As Boolean
Dim rng As Range
Dim wkbKontakt As Workbook, wksKontakt As Worksheet
Dim strPath As String
On Error GoTo Fehler
'Spalte A nach wert durchsuchen
Set rng = Sheets("Metafile").Range("A:A").find(What:=txtClient.Text, _
Lookat:=xlWhole, LookIn:=xlValues)
'Wenn wert entdeckt
If rng Is Nothing Then
find = False
MsgBox "Kontakt """ & txtClient.Text & """ nicht gefunden"
Else
find = True
If rng.Hyperlinks.Count > 0 Then
'rng.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
'Verzeichnis aus Hyperlink auslesen
strPath = rng.Hyperlinks(1).Address
'Dateinamen der Arbeitsmappe zum Klienten berechnen
strPath = strPath & Application.PathSeparator & Me.txtClient & ".xlsm"
'prüfen ob Datei vorhanden
If Dir(strPath) = "" Then
MsgBox "Im Verzeichnis: " & rng.Hyperlinks(1).Address & vbLf _
& "ist die Datei: " & Me.txtClient & ".xlsm" & vbLf & "nicht vorhanden"
Else
Application.EnableEvents = False
'Klientendatei öffnen
Set wkbKontakt = Application.Workbooks.Open(Filename:=strPath)
Set wksKontakt = wkbKontakt.Sheets("Contacts")
'Leerzeile einfügen
wksKontakt.Rows("9:9").Insert Shift:=xlDown
'Zellen ausfüllen
With Me.txtA
If .Value  "" Then wksKontakt.Range("B9").Value = .Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("C9").Value = .Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("D9").Value = .Value
End With
With Me.txtB
If .Value  "" Then wksKontakt.Range("E9").Value = .Value
End With
wkbKontakt.Save
wkbKontakt.Close
Application.EnableEvents = True
End If
Else
MsgBox "Zum Klienten """ & txtClient.Text & """ gibt es keinen Hyperlink"
End If
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.EnableEvents = True
End Sub

Anzeige
AW: Textfeld mit Spalte vergleichen etc
19.11.2013 11:54:44
Kina
Lieber Franz,
Verzeih die unpräzisen Angaben. Ich hole ein wenig aus... Ich habe ein Excel Arbeitsblatt namens Metafile wo in der Lasche Metafile in Spalte A verschienene Kontakte aufgeführt sind z.b Müller, Meier etc. (jeder Name kommt nur einmal vor) Diese Kontakte haben je einen eigenen Ordner in dem sich unter anderem das excel Arbeitsblatt Müller.xlsm befindet, welches per Hyperlink mit dem Eintrag Müller im Arbeitsblatt Metafile Lasche Metafile in Spalte A verbunden ist. Im Arbeitsblatt Müller.xlsm sind verschiedene Laschen darunter die Lasche Contacts. Was ich erreichen möchte ist, dass wenn ich in mein Formular den namen Müller eingebe die restlichen Daten des Formulars in die Zeile 9 der Lasche Contacts im Excel Arbeitsblatt Müller.xlms abgefüllt werden und ältere Einträge nach unten rutschen so dass der neuste Eintrag immer zuoberst in Zeile 9 ist. Das Selbe für Meier etc...
Danke für Deine Mühe!!!

Anzeige
AW: Textfeld mit Spalte vergleichen etc
19.11.2013 13:32:36
fcs
Hallo Kina,
wenn der Hyperlink jeweils auf die korrekte Exceldatei geht, dann sollte folgende Anpassung funktionieren.
Gruß
Franz 
Private Sub CommandButton1_Click()
Dim find As Boolean
Dim rng As Range
Dim wkbKontakt As Workbook, wksKontakt As Worksheet
Dim strPath As String
On Error GoTo Fehler
'Spalte A nach wert durchsuchen
Set rng = Sheets("Metafile").Range("A:A").find(What:=txtClient.Text, _
Lookat:=xlWhole, LookIn:=xlValues)
'Wenn wert entdeckt
If rng Is Nothing Then
find = False
MsgBox "Kontakt """ & txtClient.Text & """ nicht gefunden", vbInformation, _
"Suche nach Kontakt in Metafile Spalte A"
Else
find = True
If rng.Hyperlinks.Count > 0 Then
'Arbeitsmappe zum Klienten aus Hyperlink auslesen
strPath = rng.Hyperlinks(1).Address
'prüfen ob Datei vorhanden
If Dir(strPath) = "" Then
MsgBox "Die Datei: " & rng.Hyperlinks(1).Address & vbLf _
& "für Klient: " & Me.txtClient & vbLf & "nicht vorhanden", _
vbInformation, "Prüfen ob Hyperlink-Datei existiert"
Else
Application.EnableEvents = False
'Klientendatei öffnen
Set wkbKontakt = Application.Workbooks.Open(Filename:=strPath)
Set wksKontakt = wkbKontakt.Sheets("Contacts")
'Leerzeile einfügen
wksKontakt.Rows("9:9").Insert Shift:=xlDown
'Zellen ausfüllen
With Me.txtA
If .Value  "" Then wksKontakt.Range("B9").Value = .Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("C9").Value = .Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("D9").Value = .Value
End With
With Me.txtB
If .Value  "" Then wksKontakt.Range("E9").Value = .Value
End With
wkbKontakt.Save
wkbKontakt.Close
Application.EnableEvents = True
End If
Else
MsgBox "Zum Klienten """ & txtClient.Text & """ gibt es keinen Hyperlink", _
vbInformation, "Prüfen ob Klient ein Hyperlink zugeordnet ist"
End If
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation, "Speichern der Userform-Eingaben in Klient-Dossier"
End Select
End With
Application.EnableEvents = True
End Sub

Anzeige
AW: Textfeld mit Spalte vergleichen etc
19.11.2013 14:02:11
Kina
Lieber Franz,
Ich habs probiert aber ich kriege immer die Fehlermeldung
Die Datei C:/xyz/xy/Müller/Müller.xlsx
Für Klient: Müller
Nicht vorhanden
Müsste wohl nur der letzte Teil des Hyperlink Pfades (Müller.xlsx)ausgelesen respektive weiterverwendet werden oder? Damit sich der Name korrekt ergibt...
Mensch ohne Dich hätte ich keine Chance...

AW: Textfeld mit Spalte vergleichen etc
20.11.2013 06:05:18
fcs
Hallo Kina,
zum Öffnen der Datei benötigt Excel den kompletten Pfadnamen bestehend aus Verzeichnis und Dateiname wenn die Datei nicht im gerade aktiven Verzeichnis liegt.
Die Auswertung des Address-Parameters des Hyperlinks und die anschliessende Nutzung als Dateiname für das Öffnen der Klienten-Datei ist wegen der relativen Angabe des Pfades im Link scheinbar problematisch.
Ich hatte es auf einem Rechner mit Windows7 und Netzwerksanbindung probiert, da lief es ohne Probleme.
Auf meinem privaten Rechner mit Windows Vista ohne Netzwerk funktioniert es jetzt nicht.
Deshalb jetzt zurück zu der Version die die Klienten-Arbeitsmappe direkt über den Hyperlink öffnet. Da waren noch ein paar Korrekturen beim Eintragen der Werte nötig, die aber eigentlich nichts mit dem öffnen der Datei zu tun haben.
Wenn das jetzt auch nicht funktioniert, dann muss die Datei des Klientendossiers irgendwie anders ermittelt werden.
Entweder ausgehend vom Verzeichnis deiner Metadaten-Datei mit dem Userform
z.B.: Thisworkbook.Path & "\" & KlientenName & "\" & Me.txtClient & ".xlsm"
oder ausgehend von einem vorgegebenen Verzeichnis
z.B.: "C:\VereichnisA\VerzeichnisB\" & KlientenName & "\" & Me.txtClient & ".xlsm"
Gruß
Franz 
Private Sub CommandButton1_Click()
Dim find As Boolean
Dim rng As Range
Dim wkbKontakt As Workbook, wksKontakt As Worksheet
On Error GoTo Fehler
'Spalte A nach wert durchsuchen
Set rng = Sheets("Metafile").Range("A:A").find(What:=txtClient.Text, Lookat:=xlWhole, _
LookIn:=xlValues)
'Wenn wert entdeckt
If rng Is Nothing Then
find = False
MsgBox "Kontakt """ & txtClient.Text & """ nicht gefunden", vbInformation, _
"Suche nach Kontakt in Metafile Spalte A"
Else
find = True
If rng.Hyperlinks.Count > 0 Then
Application.EnableEvents = False
rng.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Set wkbKontakt = ActiveWorkbook
Set wksKontakt = wkbKontakt.Sheets("Contacts")
wksKontakt.Rows("9:9").Insert Shift:=xlDown
With Me.txtA
If .Value  "" Then wksKontakt.Range("B9").Value = Me.txtA.Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("C9").Value = Me.cbbXX.Value
End With
With Me.cbbXY
If .ListIndex  -1 Then wksKontakt.Range("D9").Value = Me.cbbXY.Value
End With
With Me.txtB
If .Value  "" Then wksKontakt.Range("E9").Value = Me.txtB.Value
End With
wkbKontakt.Save
wkbKontakt.Close
Application.EnableEvents = True
Else
MsgBox "Zum Klienten """ & txtClient.Text & """ gibt es keinen Hyperlink", _
vbInformation, "Prüfen ob Klient ein Hyperlink zugeordnet ist"
End If
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case -2147221014
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Datei """ & rng.Hyperlinks(1).Address & """ zum Hyperlink  existiert nicht"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.EnableEvents = True
End Sub

Anzeige
AW: Textfeld mit Spalte vergleichen etc
20.11.2013 08:45:50
Kina
Lieber Franz,
Es funktioniert!!!! Tausend Dank, das ist der Hammer!!!
Einziger Schönheitsfehler: Ich kriege jedes Mal eine Fehler Meldung:
"Datenschutzwarnung: Dieses Dokument enthält Makros, AktiveX-Steuerelemente, XML-Erweiterungspaketinformationen oder Webkomponenten. DIese enthalten möglicherweise persönliche Informationen, die durch die Dokumentprüfung nicht entfernt werden können."
Wenn ich da einfach ok, drücke verschwindet die Fehlermeldung und das Formular wird korrekt eingefüllt... Gibt es evtl eine Möglichkeit diese Fehlermeldung loszuwerden?
Liebe Grüsse
Kina

Anzeige
AW: Textfeld mit Spalte vergleichen etc
20.11.2013 08:55:08
Hajo_Zi
Hallo Kina,
speichere die Datei in einem vertrauenswürdigen Ordner.

AW: Textfeld mit Spalte vergleichen etc
20.11.2013 09:28:36
Kina
Lieber Franz,
Hab rausgefunden, dass die Fehlermeldung verschwindet, wenn ich VBA geschlossen habe :-))) Funktioniert nun also einfandfrei!!!
Nochmals vielen herzlichen Dank für Deine Mühe!!!
Liebe Grüsse
Kina

Links zu Excel-Dialogen

CommandButton UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige