Thema Datum  Von Nutzer Rating
Antwort
07.08.2023 13:32:24 Sven
Solved
07.08.2023 14:20:35 Gast49419
NotSolved
07.08.2023 15:22:44 Sven
NotSolved
07.08.2023 17:50:15 Gast78637
NotSolved
07.08.2023 18:16:20 Sven
NotSolved
07.08.2023 18:34:19 Gast59948
NotSolved
08.08.2023 06:58:57 Sven
NotSolved
08.08.2023 11:16:16 Gast40343
NotSolved
14.08.2023 15:05:32 Sven
NotSolved
15.08.2023 00:03:25 Gast27989
NotSolved
15.08.2023 08:25:11 Sven
NotSolved
Blau Okidoki - wünsche dir weiterhin Freude am proggen :)
15.08.2023 13:24:52 Gast20621
NotSolved
15.08.2023 14:27:50 Sven
NotSolved
16.08.2023 10:01:05 Gast11842
NotSolved
16.08.2023 12:09:31 Sven
NotSolved
16.08.2023 18:39:13 Gast50512
NotSolved
06.09.2023 11:24:56 Sven
NotSolved
07.09.2023 18:03:43 Gast32657
NotSolved
08.09.2023 11:25:14 sven
NotSolved
08.09.2023 14:47:37 Gast54751
NotSolved
08.09.2023 15:05:17 Gast74933
NotSolved
08.09.2023 17:41:50 Gast28898
NotSolved
11.09.2023 07:44:00 Sven
NotSolved
11.09.2023 14:06:32 Gast56381
NotSolved
07.08.2023 17:10:58 ralf_b
Solved
07.08.2023 18:09:35 Sven
NotSolved
07.08.2023 18:12:02 ralf_b
NotSolved
07.08.2023 18:17:57 Sven
NotSolved

Ansicht des Beitrags:
Von:
Gast20621
Datum:
15.08.2023 13:24:52
Views:
214
Rating: Antwort:
  Ja
Thema:
Okidoki - wünsche dir weiterhin Freude am proggen :)

Im Großen und Ganzen schon ganz gut.

Ich hab es trotzdem mal etwas hier und da mit entsprechenden Andeutungen/Kommentaren umgeschrieben.
Bachte dabei auch mal den Lesefluss, so wie du den Code lesen würdest. Beispiel:

If Not GetShortName(CStr(vntFullFilename), rngShortNames, strShortName) Then

Diese Zeile braucht ansich keinen Kommentar, denn es geht bereits aus dem Not-Operator und dem Funktionsnamen hervor, was da passiert. Ich hab es dennoch mal kommentiert.

Apropos Kommentare: Diese solltest du dringend nachholen; bei allen Funktionen. Ich habe das mal bei den letzten zwei angedeutet. Du willst dir schließlich nicht jedesmal den Code durchlesen, um zu wissen was diese tun. Der Funktionsname gibt zwar meist eine grobe Richtung vor, aber das hilft manchmal trotzdem nicht. Nach 1 bis 2 Wochen hast du ohnehin vieles wieder davon vergessen (das ist normal; geht jedem so).

 

Option Explicit
 
Sub BilderHyperlink()
  
  Dim strPath As String
  
  If GetSelectedPath(strPath) = False Then
    Exit Sub
  End If
  
  'Sammlung erstellen
  Dim colFiles As VBA.Collection
  If SearchFiles(strPath, colFiles) = 0 Then
    Call MsgBox("Keine Treffer.", vbExclamation)
    Exit Sub
  End If
  
  Dim rngShortNames As Excel.Range 'bei dir: XRgKurzbezeichnung
  
  'Auswahl: Kurzbezeichnung
  On Error Resume Next
  Set rngShortNames = Application.InputBox("Bitte den Bereich mit der Kurzbeschreibung auswählen:", "Bitte die Spalte wählen", Type:=8)
  If rngShortNames Is Nothing Then Exit Sub
  On Error GoTo 0
  
  'Auswahl: ...
  '...
  
  'Auswahl: ...
  '...
  
  Dim vntFullFilename As Variant
  Dim rngCell As Excel.Range
  Dim strShortName As String
  
  For Each vntFullFilename In colFiles
    
    ' Alle Informationen ermitteln/ bereit stellen, welche HandleFile() benötigt.
    '   Je mehr das sein werden, umso ehern sollte man sich ggf. darüber Gedanken machen,
    '   das in eine eigene Funktion auszulagern.
    '   - ist Ansichtssache.
    '   Bei sehr vielen, würde sich z.B. ein Type, oder eine Klasse anbieten,
    '   in welcher man die Einstellungen (und/oder auch innere Zustände) ablegt. Diese reicht man dann
    '   mit weiter an alle Subs/Funktionen. (so etwas wird üblicherweise als »Context« bezeichnet)
    
    'Kurzbezeichnung ermitteln
    If Not GetShortName(CStr(vntFullFilename), rngShortNames, strShortName) Then
      'normalerweise sollte man GoTo nicht verwenden
      'das hier ist jedoch eine Ausnahme, da es die Verschachtelungstiefe vom Code
      'veringert und damit den Code lesbarer macht
      ' (andere Sprachen haben ein »continue« direkt eingebaut; VBA jedoch leider nur über diesen Umweg)
      GoTo Continue_ForEach
    End If
    
    '... ermitteln
'    If Not Get...(...) Then
'      GoTo Continue_ForEach
'    End If
    
    'Zelle ermitteln
'    If Not GetCell(...) Then
'      GoTo Continue_ForEach
'    End If
    'nur zur Veranschaulichung
    ' hier nur statisch angegeben, da ich nicht genau nachvollzogen habe, wie du an diese gelangst
    ' (sollte im angedeuteten GetCell() passiern, wenn die Logik dahinter komplexer ist)
    Set rngCell = Range("A1")
    
    'Datei behandeln / Datei-Informationen verarbeiten
    Call HandleFile(rngCell, strShortName, CStr(vntFullFilename))
    
Continue_ForEach:
  Next
  
End Sub

Private Sub HandleFile(Cell As Excel.Range, TextToDisplay As String, FullFilename As String)
  
  'HINWEIS:
  ' Anhand von FullFilename könnte man hier weitere Unterscheidungen treffen,
  ' auf welche Art man diese Datei/Bild verarbeitet (z.B. unterschiedl. Positionierung).
  ' WENN du diese Information hier nicht benötigst, dann entferne den Parameter am besten,
  ' denn man sollte nur das deklariert haben, was auch benutzt wird (der Grund dafür sollte klar sein).
  
  
  ' Hyperlink setzen
  Call Cell.Worksheet.Hyperlinks.Add(Cell, FullFilename, , , TextToDisplay)
  
  ' Bild in Kommentar setzen
  With Cell.AddComment
    Call .Shape.Fill.UserPicture(FullFilename)
    .Shape.Height = 260
    .Shape.Width = 520
    .Shape.LockAspectRatio = msoFalse
  End With
  
End Sub

Private Function GetShortName(FullFilename As String, Range As Excel.Range, ByRef ShortName As String) As Boolean
  
  'nur zur Veranschaulichung
  
  ' da ich nicht genau nachvollzogen habe, wie du vom Dateinamen
  ' auf die Kurzbezeichnung kommst
  ShortName = Range.Cells(1, 1).Value
  
  'die Suche war erfolgreich
  GetShortName = True
  
End Function

Private Function GetSelectedPath(ByRef SelectedPath As String) As Boolean
  
  'Ordner Auswählen
  With Application.FileDialog(msoFileDialogFolderPicker)
    
    .Title = "Bitte den Ordner mit den Bildern wählen:"
    .InitialFileName = Application.ActiveWorkbook.Path
    .AllowMultiSelect = False
    
    If .Show() = 0 Then
      Call MsgBox("Keinen Ordner Ausgewählt", vbInformation, "/ Information")
      Exit Function
    End If
    
    SelectedPath = .SelectedItems(1)
    
  End With
  
  GetSelectedPath = True
  
End Function

'////////////////////////////////////////////////
'// Untersucht eine Dateiangabe nach bestimmten Kritieren.
'// Liefert:
'//   TRUE, wenn diese Datei berücksichtigt werden soll.
Private Function CheckFile(FullFilename As String) As Boolean
  
'  ' Dieser Fall wird bereits durch den Check nach png mit abgedeckt.
'  If Right$(FullFilename, Len("thumbs.dp")) = "thumbs.dp" Then
'    'Thumbs nicht berücksichtigen
'    Exit Function
'  End If
  
  'nur PNG-Dateien berücksichtigen
  If Right$(FullFilename, 4) <> ".png" Then
    Exit Function
  End If
  
  CheckFile = True
  
End Function
  
'////////////////////////////////////////////////
'// Durchsucht alle Unterordner nach bestimmten Dateien.
'// - siehe auch: CheckFile()
'// Liefert:
'//   Die Anzahl der Dateien in 'FoundFiles'.
Private Function SearchFiles(Path As String, FoundFiles As VBA.Collection) As Long
   
  If FoundFiles Is Nothing Then
    Set FoundFiles = New VBA.Collection
  End If
    
  Dim strPath As String
  Dim strFilename As String
    
  strPath = IIf(Right$(Path, 1) <> "\", Path & "\", Path)
    
  On Error GoTo ErrHandler
  strFilename = Dir$(strPath, vbDirectory)
  On Error GoTo 0
    
  Dim fileAttr As VbFileAttribute
  Dim colDirectories As VBA.Collection
  Set colDirectories = New VBA.Collection
    
  Do While strFilename <> vbNullString
      
    On Error GoTo ErrHandler
    fileAttr = -1
    fileAttr = GetAttr(strPath & strFilename)
    On Error GoTo 0
      
    If (fileAttr And vbDirectory) = vbDirectory And Not (fileAttr And vbSystem) = vbSystem Then
      If strFilename = "." Or strFilename = ".." Then
        GoTo Continue_Do
      End If
      Call colDirectories.Add(strPath & strFilename)
        
    ElseIf (fileAttr And vbNormal) = vbNormal And Not (fileAttr And vbSystem) = vbSystem Then
      If CheckFile(strPath & strFilename) Then
        Call FoundFiles.Add(strPath & strFilename)
      End If
        
    End If
      
Continue_Do:
    strFilename = Dir$()
  Loop
    
  DoEvents
  Dim vntDirectory As Variant
  For Each vntDirectory In colDirectories
    Call SearchFiles(CStr(vntDirectory), FoundFiles)
  Next
    
  SearchFiles = FoundFiles.Count
    
Exit Function
 
ErrHandler:
  'TODO: implement proper logging
  Debug.Print Format$(Now, "yyyy-mm-dd"); Tab(12); "'"; Err.Source; "'"; _
              Tab(2); "Path: '"; strPath & strFilename; "'"; _
              Tab(4); "=> '"; Err.Description; "'"
  Resume Next
End Function

Grüße

PS: Die Bezeichner von Variablen habe ich weiterhin nach meinem Stil gewählt.

Mein Rat hierzu wäre: Bleib bei dem Stil, welcher dir am besten zusagt und mische sie nicht. Soll heißen, benenne Variablen ggf. um, damit sie deinem Stil entsprechen - Beispiel: rngShortNames und XRgKurzbezeichnung. Das gleiche gilt übrigens auch ob du Englisch oder Deutsche Bezeichner verwendest solltest. Die meisten wählen Englisch, weil die Sprach-Syntax selbst in Englisch ist und es sich so einfach besser ließt. Wenn du jedoch deutsche Bezeichner lieber hast, dann ist das auch nicht falsch - nur etwas seltsam. ;o)

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
07.08.2023 13:32:24 Sven
Solved
07.08.2023 14:20:35 Gast49419
NotSolved
07.08.2023 15:22:44 Sven
NotSolved
07.08.2023 17:50:15 Gast78637
NotSolved
07.08.2023 18:16:20 Sven
NotSolved
07.08.2023 18:34:19 Gast59948
NotSolved
08.08.2023 06:58:57 Sven
NotSolved
08.08.2023 11:16:16 Gast40343
NotSolved
14.08.2023 15:05:32 Sven
NotSolved
15.08.2023 00:03:25 Gast27989
NotSolved
15.08.2023 08:25:11 Sven
NotSolved
Blau Okidoki - wünsche dir weiterhin Freude am proggen :)
15.08.2023 13:24:52 Gast20621
NotSolved
15.08.2023 14:27:50 Sven
NotSolved
16.08.2023 10:01:05 Gast11842
NotSolved
16.08.2023 12:09:31 Sven
NotSolved
16.08.2023 18:39:13 Gast50512
NotSolved
06.09.2023 11:24:56 Sven
NotSolved
07.09.2023 18:03:43 Gast32657
NotSolved
08.09.2023 11:25:14 sven
NotSolved
08.09.2023 14:47:37 Gast54751
NotSolved
08.09.2023 15:05:17 Gast74933
NotSolved
08.09.2023 17:41:50 Gast28898
NotSolved
11.09.2023 07:44:00 Sven
NotSolved
11.09.2023 14:06:32 Gast56381
NotSolved
07.08.2023 17:10:58 ralf_b
Solved
07.08.2023 18:09:35 Sven
NotSolved
07.08.2023 18:12:02 ralf_b
NotSolved
07.08.2023 18:17:57 Sven
NotSolved