HERBERS Excel-Forum - die Beispiele

Thema: Laufwerke im Dialog zur Auswahl anzeigen lassen

Home

Gruppe

Dialog

Problem

Wie kann ich mir alle verfügbaren Festplatten und CD-Rom-Laufwerke im Dialog zur Auswahl anzeigen lassen?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain

Sub GetDrives()
   Dim frmNew As Object
   Dim chb As MSForms.CheckBox
   Dim cmd As MSForms.CommandButton
   Dim arr() As String
   Dim iCounter As Integer, iDrive As Integer
   Dim iTop As Integer
   Dim sCode As String
   On Error Resume Next
   For iCounter = 65 To 90
      ChDrive Chr(iCounter)
      If Err > 0 Then
         Err.Clear
      Else
         iDrive = iDrive + 1
         ReDim Preserve arr(1 To iDrive)
         arr(iDrive) = Chr(iCounter)
      End If
   Next iCounter
   Application.VBE.MainWindow.Visible = False
   Set frmNew = ThisWorkbook.VBProject.VBComponents("frmDrives")
   If Err = 0 Then GoTo ERRORHANDLER
   On Error GoTo 0
   Set frmNew = ThisWorkbook.VBProject.VBComponents.Add(3)
   iTop = 5
   For iCounter = 1 To UBound(arr)
      Set chb = frmNew.Designer.Controls.Add("forms.CheckBox.1")
      With chb
         .Top = iTop
         .Left = 5
         .Width = 100
         .Caption = "Laufwerk " & arr(iCounter)
      End With
      iTop = iTop + 20
   Next iCounter
   Set cmd = frmNew.Designer.Controls.Add("forms.CommandButton.1")
   With cmd
      .Top = iTop
      .Left = 5
      .Width = 100
      .Height = 25
      .Caption = "OK"
      .Name = "cmdOK"
   End With
   iTop = iTop + 30
   Set cmd = frmNew.Designer.Controls.Add("forms.CommandButton.1")
   With cmd
      .Top = iTop
      .Left = 5
      .Width = 100
      .Height = 25
      .Caption = "Abbrechen"
      .Name = "cmdCancel"
   End With
   With frmNew
      .Properties("Width") = 118
      .Properties("Height") = iTop + 50
      .Properties("Caption") = "Laufwerke"
      .Properties("Name") = "frmDrives"
   End With
   sCode = "Private Sub cmdCancel_Click" & vbLf
   sCode = sCode & "   Unload Me" & vbLf
   sCode = sCode & "End Sub" & vbLf & vbLf
   sCode = sCode & "Private Sub cmdOK_Click" & vbLf
   sCode = sCode & "   Dim sCode as String" & vbLf
   sCode = sCode & "   Dim iCounter As Integer" & vbLf
   sCode = sCode & "   sCode = ""Ausgewählte Laufwerke: ""& vbLf" & vbLf
   sCode = sCode & "   For iCounter = 1 to " & UBound(arr) & vbLf
   sCode = sCode & "      If Controls(""CheckBox"" & iCounter).Value"
   sCode = sCode & " = True Then" & vbLf
   sCode = sCode & "         sCode = sCode & Controls(""CheckBox"""
   sCode = sCode & " & iCounter).Caption & vbLf" & vbLf
   sCode = sCode & "      End If" & vbLf
   sCode = sCode & "   Next iCounter" & vbLf
   sCode = sCode & "   MsgBox sCode" & vbLf
   sCode = sCode & "End Sub" & vbLf
   ThisWorkbook.VBProject.VBComponents("frmDrives").CodeModule.AddFromString sCode
ERRORHANDLER:
   VBA.UserForms.Add(frmNew.Name).Show
   ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(frmNew.Name)
End Sub

Beiträge aus dem Excel-Forum zu den Themen Dialog und CheckBox

Probleme bei Anklicken von Checkboxen Checkboxen Namen beliebig in eine Zelle schreiben
Fehler bei Abfrage mehrerer Checkboxen ListBox mit CheckBox bei Auswahl Page anzeigen
graues Häckchen in CheckBox xlDialogInsertHyperlink.show
Checkbox in UF aus Modul zurücksetzen Arbeitmappen über Dialogfeld zusammen fassen
Combobox, CheckBox, TextBox Formatierung UserForm - CheckBox Reihenfolge
5.0 Dialog Checkbox
Speichern unter Dialog in Word aufrufen inkl. Pfad disable CheckBox, wenn...
checkbox merken Druckerdialog
Dateityp im "Speichern unter"-Dialog vorgeben Makro stoppen, wenn Excel-Dialog?
checkbox xlDialogOpen anpassen
checkbox als Gruppe ansprechen Klick in definierten Rangebereich startet Dialog
Checkbox mit Bedingung For Each Checkbox und stop nach letzen Durchlauf
CheckBox Schrift ausrichtung xlDialogOpen bei Excel 2007 funzt nicht
FileDialog inkl. Anklicken von Desktop, Eigene D. Klicks in CheckBox (UF) in TextBox hochzählen
Grösse Dialogfenster der InputBox CheckBoxen gruppieren
CheckBox Checkbox aktivieren
Checkbox - LinkedCell - Blattschutz Ereignis von Laufzeit-Checkbox
Checkbox in Zeile der activen Zelle Checkbox ohne VBA auslesen?
Checkbox per Makro an/aus CheckBoxen in UF zurücksetzen
Dialogfeld unterdrücken UF mit Checkboxen
Checkbox Checkbox
Register aktivieren über Checkbox Haken in Checkbox löschen
Dialog "permanently delete sheets" unterbinden Klasse für Checkboxen
Häckchen in CheckBox Hilfe bei Code für CheckBox
For Each CheckBox, Change Value Format-Dialog funktioniert nicht mehr