Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

Funktion als Makro

Betrifft: Funktion als Makro von: Günter
Geschrieben am: 08.10.2014 00:24:16

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

  

Betrifft: AW: Funktion als Makro von: Hajo_Zi
Geschrieben am: 08.10.2014 06:39:15

Hallo Günter,

wann soll das Makro ausgeführt werden?
Vielleicht reicht schon
Funktion ausführen bei Änderung einer Zelle
Application.Volatile

GrußformelHomepage


  

Betrifft: AW: Funktion als Makro von: Günter
Geschrieben am: 08.10.2014 10:39:03

Hallo Hajo,

Ich hatte es schon mit Application.Volatile in der Funktion probiert.
Ich werde aber nochmal testen.

Danke erstmal,
Günter


  

Betrifft: AW: Funktion als Makro von: Günter
Geschrieben am: 08.10.2014 15:41:59

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


  

Betrifft: AW: Funktion als Makro von: Franc
Geschrieben am: 09.10.2014 05:37:39

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



  

Betrifft: AW: Funktion als Makro von: Günter
Geschrieben am: 09.10.2014 14:13:12

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


  

Betrifft: AW: Funktion als Makro von: Franc
Geschrieben am: 09.10.2014 17:06:58

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



  

Betrifft: AW: Funktion als Makro von: Günter
Geschrieben am: 09.10.2014 18:24:19

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


  

Betrifft: AW: Funktion als Makro von: Franc
Geschrieben am: 09.10.2014 20:50:04

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



  

Betrifft: AW: Funktion als Makro von: Günter
Geschrieben am: 10.10.2014 01:42:05

Hallo Franc,
Funktioniert genial gut ;)
USB-Stick wird super erkannt.
Vielen Dank,
Günter


 

Beiträge aus den Excel-Beispielen zum Thema "Funktion als Makro"