MLD - Kanalliste in Excel

Aus VDR Wiki

Wechseln zu: Navigation, Suche

Zur Verbesserungs des WAF's und für die eigene Bequemlichkeit habe ich ein Excel-Makro geschrieben, mit dem ich die Kanalbelegung in ein "lesbares" Format bringe

Hinweis
Hinweis

Bitte nicht auf die Idee kommen, die channels.conf so zu bearbeiten und dann im VDR wieder zu verwenden!!


Dazu das unten angefügte VBA-Skript in eine neue Excel-Tabelle, z.B. Kanalbelegung.xls als Makro einfügen. Die channels.conf in channels.csv umbenennen und per Doppelklick öffnen. Die erste Spalte markieren und in der Kanalbelegung.xls in der 3. Spalte einfügen. Makro ausführen. In der ersten Spalte stehen jetzt die Sendernummern, in der 2. die Sendernamen. Nun noch das ganze passend formatieren (Schriftart, fett, usw.) und die Spalten so weit verbreitern, dass nur die erste und zweite Spalte auf einer Seite ausgedruckt werden.


Es ist also derzeit noch ein wenig Handarbeit erforderlich, aber so bekommt man mit wenigen Klicks eine schöne Übersicht über die zur Verfügung stehenden Kanäle

 Sub Kanalbelegung()
 '
 ' Makro1 Makro
 '
 Columns("A:B").Select
 Selection.ClearContents
 Range("A1").Select
 
 zeile = 1
 spalte = 3
 Cells(zeile, spalte).Select
 Kanal = ActiveCell
 Application.ScreenUpdating = False
 While ActiveCell <> ""
 If Left(Kanal, 1) = ":" Then
 Kanalname = Kanal
 Else
 For x = 2 To 40
 If Mid(Kanal, x, 1) = ";" Or Mid(Kanal, x, 1) = ":" Then
 Kanalname = Left(Kanal, x - 1)
 GoTo weiter
 Else
 Kanalname = Kanal
 End If
 Next
 End If
 weiter:
 Cells(zeile, spalte - 1).Select
 ActiveCell = Kanalname
 
 zeile = zeile + 1
 Cells(zeile, spalte).Select
 Kanal = ActiveCell
 Wend
 
 
 endzeile = zeile
 
 'Kanalnummern in Spalte 1 eintragen
 n = 1
 For zeile = 1 To endzeile
 spalte = 2
 Cells(zeile, spalte).Select
 If Left(Cells(zeile, 2), 1) <> ":" Then
 Cells(zeile, 1) = n
 n = n + 1
 Else
 Cells(zeile, 1) = ""
 If Mid(Cells(zeile, 2), 2, 1) = "@" Then
 m = 1
 While (Mid(Cells(zeile, 2), 3, m)) > 0 And m < 5
 nummernkreis = Mid(Cells(zeile, 2), 3, m)
 m = m + 1
 Wend
 n = nummernkreis
 End If
 End If
 Next 
 
 Application.ScreenUpdating = True
 zeile = 1
 spalte = 1
 Cells(zeile, spalte).Select
 End Sub