Benutzer:Schreibkraft/Excel-Meta-Auflagen-Fachpresse-DE.vba

Hier nachstehend ist der Code für EXCEL-Umwandlung von IVW-Auflagendaten für Fachpresse für die PC-Version EXCEL-2003.

Hinweise zur Einbindung des Codes in eine Excel-Datei finden sich hier.

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Löscht überflüssige Einträge und ersetzt Abkürzungen bei Fachpresse
'Verbesserungsvorschläge und Rückfragen bitte an http://de.wikipedia.org/wiki/Benutzer_Diskussion:Schreibkraft
Dim Zahl, LastRow, Zielzahl, Quartal, Jahr, byWert As Integer
Dim Quartalstext As String
 
 
If CheckSheet("Wikipedia-Daten") = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Wikipedia-Daten"
End If

LastRow = Range("A" & Rows.Count).End(xlUp).Row

'Löscht alte Tabelle
Worksheets("Wikipedia-Daten").Range("A1:Z10000").EntireRow.Clear

'Ermittelt Quartal
Quartal = Mid(Range("A2"), 5, 1)
'Ermittelt Jahr
Jahr = Mid(Range("A2"), 1, 4)

If Quartal = 1 Then
  Quartalstext = "erstes Quartal"
  ElseIf Quartal = 2 Then
  Quartalstext = "zweites Quartal"
  ElseIf Quartal = 3 Then
  Quartalstext = "drittes Quartal"
    ElseIf Quartal = 4 Then
  Quartalstext = "viertes Quartal"
   End If
   
   'Schreibt Vorspann
Worksheets("Wikipedia-Daten").Range("A1").Value = "{{#switch: {{{1}}}"
Worksheets("Wikipedia-Daten").Range("A2").Value = "| Quartalstext = {{#switch: {{{2}}}"
Worksheets("Wikipedia-Daten").Range("A3").Value = "| Liste und Infobox = [[Informationsgemeinschaft zur Feststellung der Verbreitung von Werbeträgern|IVW]] " & Quartal & "/" & Jahr
Worksheets("Wikipedia-Daten").Range("A4").Value = "| Artikel           = laut [[Informationsgemeinschaft zur Feststellung der Verbreitung von Werbeträgern|IVW]], " & Quartalstext & " " & Jahr
Worksheets("Wikipedia-Daten").Range("A5").Value = "| IVW-Kürzel        = " & Range("A2") & "}}"

'Ersetzt Abkürzungen
For Zahl = 2 To LastRow Step 1
Zielzahl = Zahl + 4
Cells(Zahl, "H") = Replace(Cells(Zahl, "H"), "tgl", "täglich")
Cells(Zahl, "H") = Replace(Cells(Zahl, "H"), "jähr", "jährlich")
Cells(Zahl, "H") = Replace(Cells(Zahl, "H"), "woe", "wöchentlich")
Cells(Zahl, "H") = Replace(Cells(Zahl, "H"), "mtl", "monatlich")

'Erstellt Daten für Wikipedia
Worksheets("Wikipedia-Daten").Range("A" & Zielzahl).Value = "| " & Range("C" & Zahl).Value & " = {{#switch: {{{2}}}| Titel = " & Range("D" & Zahl).Value & "|Verk = " & Range("L" & Zahl).Value & "| Verbr = " & Range("K" & Zahl).Value & "}}"
Next Zahl
Worksheets("Wikipedia-Daten").Range("A" & LastRow + 5).Value = "}}<noinclude>"
Worksheets("Wikipedia-Daten").Range("A" & LastRow + 6).Value = "{{Dokumentation}}"
Worksheets("Wikipedia-Daten").Range("A" & LastRow + 7).Value = "</noinclude>"
'Kopiert Daten in Zwischenablage
Worksheets("Wikipedia-Daten").Activate
Worksheets("Wikipedia-Daten").Range("A1:A" & LastRow + 7).Copy


'ruft Wikipedia-Seite Vorlage:Metadaten_Auflagen_Zeitungen_DE auf
byWert = MsgBox("Möchten Sie die Daten in die Wikipedia-Vorlage einfügen?", 3)

 If StrPtr(byWert) = 0 Then
           Exit Sub
        ElseIf byWert = 6 Then
         ThisWorkbook.FollowHyperlink "http://de.wikipedia.org/w/index.php?title=Vorlage:Metadaten_Auflagen_Fachpresse_DE&action=edit"
       Exit Sub
       ElseIf byWert = 7 Then
    Exit Sub
    ElseIf byWert = 2 Then
    Exit Sub
    End If
    
'erstellt eigene Vorlage für Auflagen-Diagramm jeweils zum vierten Quartal
If Quartal = 4 Then
  byWert = MsgBox("Möchten Sie die Vorlage zum viertel Quartal erstellen?", 3)
  If StrPtr(byWert) = 0 Then
           Exit Sub
        ElseIf byWert = 6 Then
          ThisWorkbook.FollowHyperlink "http://de.wikipedia.org/w/index.php?title=Vorlage:Metadaten_Auflagen_Fachpresse_DE_" & Range("A2") & "&action=edit"
       ElseIf byWert = 7 Then
    ElseIf byWert = 2 Then
    End If
End If


End Sub


Public Function CheckSheet(Name As String) As Boolean
 
  On Error Resume Next
 
  CheckSheet = Not CBool(Name <> ThisWorkbook.Worksheets(Name).Name)
 
End Function