Public Sub Export()
Dim Folder As String
Dim Answer As Integer
Folder = "C:\Export_Translation"
If Dir(Folder, vbDirectory) <> "" Then
MsgBox "Export to " & Folder & "."
Else
Answer = MsgBox("The Folder " & Folder & " doesn't exist." _
& vbNewLine _
& "create the Folder?", vbYesNo)
If Answer = vbYes Then
MkDir Folder
MsgBox "Folder " & Folder & " created."
End If
End If
Dim Area As Range
Dim Pfad As String
If ActiveSheet.Name = "DE" Then
Pfad = "C:/Export_Translation/nls_de.properties"
ElseIf ActiveSheet.Name = "EN" Then
Pfad = "C:/Export_Translation/nls_en.properties"
ElseIf ActiveSheet.Name = "CN" Then
Pfad = "C:/Export_Translation/nls_cn.properties"
ElseIf ActiveSheet.Name = "ES" Then
Pfad = "C:/Export_Translation/nls_es.properties"
ElseIf ActiveSheet.Name = "FR" Then
Pfad = "C:/Export_Translation/nls_fr.properties"
ElseIf ActiveSheet.Name = "IT" Then
Pfad = "C:/Export_Translation/nls_it.properties"
ElseIf ActiveSheet.Name = "RU" Then
Pfad = "C:/Export_Translation/nls_ru.properties"
ElseIf ActiveSheet.Name = "CZ" Then
Pfad = "C:/Export_Translation/nls_cz.properties"
ElseIf ActiveSheet.Name = "BG" Then
Pfad = "C:/Export_Translation/nls_bg.properties"
ElseIf ActiveSheet.Name = "HU" Then
Pfad = "C:/Export_Translation/nls_hu.properties"
ElseIf ActiveSheet.Name = "PT" Then
Pfad = "C:/Export_Translation/nls_pt.properties"
End If
Set Area = Range("A2:B1639" & Range("H65536").End(xlUp).Row)
Area.Copy
Open Pfad For Output As #1
Print #1, Replace(ClpLesen, vbTab, "=")
Close #1
MsgBox "Successfully exported to " & Folder & "."
End Sub
Public Function ClpLesen() As String
Dim IE As Object
On Error Resume Next
Set IE = CreateObject("HTMLfile")
ClpLesen = IE.ParentWindow.ClipboardData.GetData("text")
Set IE = Nothing
End Function