Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:07:03
Alternative Summewenn für Verlinkung closed Workbook
23.04.2024 13:44:37
Datum in Excelformel anzeigen
23.04.2024 13:31:41
alle Tabellblätter als csv exportieren - Verzeichnis wählen
23.04.2024 13:19:18
Daten aus externer Datei als Bereich übernehmen... ?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1384to1388
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
1384to1388
1384to1388
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Funktion als Makro

Funktion als Makro
08.10.2014 00:24:16
Günter
Hallo,
Wollte mal anfragen, ob es möglich ist, diese Funktion als Makro umzuschreiben?
Hatte es als Funktion laufen, aber da ist es nicht so besonders, da die Zellen sich nicht richtig aktualisieren.
Sinn ist es, den Laufwerksbuchstaben eines USB-Sticks herauszufinden. 
Public Function fncUSB_LW() As String
On Error GoTo Fehler
Dim strBuchstaben As String, i As Integer
strBuchstaben = "DEFGHIJKLMNOP"
For i = 1 To Len(strBuchstaben)
fncUSB_LW = Mid(strBuchstaben, i, 1) & ":\LW_Test.txt"
If Dir(fncUSB_LW)  "" Then
fncUSB_LW = Mid(strBuchstaben, i, 1) & ":\"
Exit Function
End If
NachFehler52:
Next i
fncUSB_LW = "USB Stick nicht vorhanden"
Exit Function
Fehler:
If Err.Number = 52 Then
Resume NachFehler52:
Else
MsgBox Err.Number, Err.Description
End If
End Function

'Aufruf in Zelle mit =fncUSB_LW()
'LW_Test.txt muss auf Laufwerk sein
Ich hoffe mal, das jemand mir helfen kann,
Günter

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Funktion als Makro
08.10.2014 06:39:15
Hajo_Zi
Hallo Günter,
wann soll das Makro ausgeführt werden?
Vielleicht reicht schon
Funktion ausführen bei Änderung einer Zelle
Application.Volatile

AW: Funktion als Makro
08.10.2014 10:39:03
Günter
Hallo Hajo,
Ich hatte es schon mit Application.Volatile in der Funktion probiert.
Ich werde aber nochmal testen.
Danke erstmal,
Günter

AW: Funktion als Makro
08.10.2014 15:41:59
Günter
Hallo,
also ich habs mal so vorerst gelöst:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Visible = True
End Sub


Private Sub Workbook_Open()
Application.Visible = False
'Aktualisierung von Function im Tabellenblatt anstossen
'Eine nicht verwendete Spalte löschen
Columns("Q:Q").Delete
UserForm1.Show
End Sub

Aber ob man diese Function als Makro schreiben kann, interessiert mich schon noch.
Darum lass ich mal offen.
Gruss,
Günter

Anzeige
AW: Funktion als Makro
09.10.2014 05:37:39
Franc
Als Makro umschreiben ist einfach aber die Frage ist immer noch offen wann das ausgelöst werden soll, wo die Daten stehen und wo das Ergebnis hin soll.
Am besten du bastelst kurz eine Beispieltabelle oder du beschreibst es genauer.
Mal ein Beispiel wie das aussehen kann, wenn der Nutzer im Bereich A1 bis A10 was eintragen kann und entsprechend in B1 bis B10 dann was stehen soll.
Das löst erst aus, wenn die Zelle geändert wird. Soll das auch auslösen wenn man nur die Zelle anklickt muss man Worksheet_SelectionChange nehmen. Der Code kommt in das entsprechende Tabellenblatt.
Mann kann das natürlich auch als Schleife schreiben das er alles noch mal prüft.
Hierzu sollte man aber auch einen Bereich festlegen wo das dann ausgelöst wird oder man macht einen button den man anklicken kann, schreibt das entsprechend um und fertig.
Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Or Target.Value = "" Then Exit Sub
If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
On Error GoTo Fehler
Dim strBuchstaben As String, strLW As String, i As Integer
strBuchstaben = "DEFGHIJKLMNOP"
For i = 1 To Len(strBuchstaben)
strLW = Mid(strBuchstaben, i, 1) & ":\LW_Test.txt"
If Dir(strLW)  "" Then
Cells(Target.Row, 2) = strLW
Exit Sub
End If
NachFehler52:
Next i
Cells(Target.Row, 2) = "USB Stick nicht vorhanden"
Exit Sub
Fehler:
If Err.Number = 52 Then
Resume NachFehler52:
Else
MsgBox Err.Number, Err.Description
End If
End If
End Sub

Anzeige
AW: Funktion als Makro
09.10.2014 14:13:12
Günter
Hallo,
am besten wäre die Möglichkeit, das Makro mit einem Button zu starten (Userform; USB prüfen),
und der "USB-LW-Buchstabe" würde in eine Hilfszelle (z.B. B1) geschrieben werden.
Möglich wäre ja dann auch noch die Erstprüfung beim Start.
Auslösen über Tabelle ist dann nicht nötig, da der LW-Buchstabe, wenn geprüft, selten wechseln wird.
Nur wenn vorher anderer USB-Stick eingesteckt wurde, oder an einem anderem Rechner.
Toll, wenn das machbar wäre,
Gruss,
Günter

AW: Funktion als Makro
09.10.2014 17:06:58
Franc
Das kannst du in ein normale Modul kopieren und mit einem normalen Button verknüpfen.
Damit wird das einmal beim öffnen der Arbeitsmappe ausgeführt und jedes mal wenn man den zugehörigen Button anklickt.
Sub Auto_Open()
Dim strLW As String
strLW = Range("B1").Value
'schauen ob es 1 Buchstabe ist und auch nur einer eingegeben wurde
If Len(strLW) = 1 And strLW Like "[a-z A-Z]" Then
strLW = strLW & ":\LW_Test.txt"
If Dir(strLW)  "" Then
Range("C1") = strLW
Else
Range("C1") = "USB Stick nicht vorhanden"
End If
Else
Range("C1") = "Kein gültiger Laufwerksbuchstabe"
End If
End Sub

Anzeige
AW: Funktion als Makro
09.10.2014 18:24:19
Günter
Hallo Franc,
funktioniert schon super, aber ich hatte mich, so denke ich, unklar ausgedrückt,
gemeint war, daß (wie in der ursprünglichen Function) das Makro selbst den USB-Stick findet
und in die Hilfszelle B1 den USB-LW-Buchstaben einträgt.
Im Moment prüft das Makro, ob in B1 der richtige USB-LW-Buchstaben steht.
Wäre super, wenns noch machbar wäre,
Günter

AW: Funktion als Makro
09.10.2014 20:50:04
Franc 

Sub Auto_Open()
Dim strBuchstaben As String, strLW As String, i As Integer
On Error GoTo Fehler
strBuchstaben = "DEFGHIJKLMNOP"
For i = 1 To Len(strBuchstaben)
strLW = Mid(strBuchstaben, i, 1) & ":\LW_Test.txt"
If Dir(strLW)  "" Then
Range("B1").Value = Mid(strBuchstaben, i, 1) & ":\"
Exit Sub
End If
NachFehler52:
Next i
Range("B1").Value = "USB Stick nicht vorhanden"
Exit Sub
Fehler:
If Err.Number = 52 Then
Resume NachFehler52
Else
MsgBox Err.Number, Err.Description
End If
End Sub

Anzeige
AW: Funktion als Makro
10.10.2014 01:42:05
Günter
Hallo Franc,
Funktioniert genial gut ;)
USB-Stick wird super erkannt.
Vielen Dank,
Günter

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige