Sub print2()
Application.DisplayAlerts = False
Dim count As Integer
count = 0
Dim i As Integer
i = 1
Dim zz As Worksheet
For Each zz In ActiveWorkbook.Worksheets
If i > 5 Then
zz.Delete
End If
i = i + 1
Next zz
Dim langchoice As Integer
langchoice = CInt(InputBox("Please enter 0 for english,1 for french and other for spanish"))
Dim answerval As String
answerval = test1(langchoice)
Sheets("Currencies").Select
Range("B2").Select
While ActiveCell.Value <> ""
Dim tempval As String
tempval = ActiveCell.Value
Dim Signal As Boolean
Signal = False
Dim activecelladdress As String
activecelladdress = ActiveCell.Address
For Each oSheet In ActiveWorkbook.Sheets
'activecelladdress = ActiveCell.Address
If oSheet.Name = tempval Then
oSheet.Delete
Signal = True
End If
Next oSheet
If Signal = True Then
Signal = False
Else
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
ws.Name = tempval
count = count + 1
ActiveSheet.Range("A2").Select
ActiveCell.Value = "FullDateAlternateKey"
ActiveCell.Offset(0, 1).Value = "Average Rate"
ActiveCell.Offset(0, 2).Value = "EndofDayRate"
ActiveCell.Offset(0, 3).Value = "Variation"
ActiveCell.Offset(0, 4).Value = "DayOfTheWeek"
Sheets("Dates").Select
Range("B2").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(tempval).Select
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Data").Select
Range("C2").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(tempval).Select
Range("B3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Data").Select
Range("D2").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(tempval).Select
Range("C3").Select
ActiveSheet.Paste
Range("C3").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0.0000"
Application.CutCopyMode = False
Sheets("Data").Select
Range("E1").Select
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A1000")
ActiveCell.Range("A1:A1000").Select
Selection.Copy
Sheets(tempval).Select
Range("D3").Select
ActiveSheet.Paste
Range("D3").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0.0000"
Application.CutCopyMode = False
Sheets("Data").Select
Columns(5).EntireColumn.Delete
Sheets(tempval).Select
'this is for translation
Range("E3").Select
ActiveCell.Value = answerval
'this is for tabular design
Sheets(tempval).Select
Range("A2:E2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A1:F1").Select
ActiveCell.FormulaR1C1 = "Table By VBA Coding"
Columns("A:E").EntireColumn.AutoFit
Signal = False
End If
Sheets("Currencies").Select
Range(activecelladdress).Select
ActiveCell.Offset(1, 0).Select
Wend
Sheets("tempdata").Delete
MsgBox ("the number of sheets created is " & count)
Application.DisplayAlerts = False
End Sub
Function test1(ByVal userchoice As String) As String
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
ws.Name = "tempdata"
Dim s As String
Sheets("tempdata").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=TEXT(NOW(),""ddd"")"
Dim todayval As String
s = ActiveCell.Value
ActiveCell.Value = ""
Dim answer As String
'Dim userchoice As String
'userchoice = InputBox("Please enter 0 for english,1 for french and other for spanish")
If userchoice = "0" Then
answer = transalte_using_vba(s, "en")
ElseIf userchoice = "1" Then
answer = transalte_using_vba(s, "fr")
Else
answer = transalte_using_vba(s, "es")
End If
test1 = answer
End Function
Function transalte_using_vba(str, langchoice) As String
' Tools Refrence Select Microsoft internet Control
Dim IE As Object, i As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String
Dim CLEAN_DATA
Set IE = CreateObject("InternetExplorer.application")
' TO CHOOSE INPUT LANGUAGE
inputstring = "auto"
' TO CHOOSE OUTPUT LANGUAGE
outputstring = langchoice
text_to_convert = str
'open website
IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:10"))
Do Until IE.ReadyState = 4
DoEvents
Loop
CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "", ""), "<")
For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
Next
IE.Quit
transalte_using_vba = result_data
End Function
Application.DisplayAlerts = False
Dim count As Integer
count = 0
Dim i As Integer
i = 1
Dim zz As Worksheet
For Each zz In ActiveWorkbook.Worksheets
If i > 5 Then
zz.Delete
End If
i = i + 1
Next zz
Dim langchoice As Integer
langchoice = CInt(InputBox("Please enter 0 for english,1 for french and other for spanish"))
Dim answerval As String
answerval = test1(langchoice)
Sheets("Currencies").Select
Range("B2").Select
While ActiveCell.Value <> ""
Dim tempval As String
tempval = ActiveCell.Value
Dim Signal As Boolean
Signal = False
Dim activecelladdress As String
activecelladdress = ActiveCell.Address
For Each oSheet In ActiveWorkbook.Sheets
'activecelladdress = ActiveCell.Address
If oSheet.Name = tempval Then
oSheet.Delete
Signal = True
End If
Next oSheet
If Signal = True Then
Signal = False
Else
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
ws.Name = tempval
count = count + 1
ActiveSheet.Range("A2").Select
ActiveCell.Value = "FullDateAlternateKey"
ActiveCell.Offset(0, 1).Value = "Average Rate"
ActiveCell.Offset(0, 2).Value = "EndofDayRate"
ActiveCell.Offset(0, 3).Value = "Variation"
ActiveCell.Offset(0, 4).Value = "DayOfTheWeek"
Sheets("Dates").Select
Range("B2").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(tempval).Select
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Data").Select
Range("C2").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(tempval).Select
Range("B3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Data").Select
Range("D2").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(tempval).Select
Range("C3").Select
ActiveSheet.Paste
Range("C3").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0.0000"
Application.CutCopyMode = False
Sheets("Data").Select
Range("E1").Select
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A1000")
ActiveCell.Range("A1:A1000").Select
Selection.Copy
Sheets(tempval).Select
Range("D3").Select
ActiveSheet.Paste
Range("D3").Select
ActiveCell.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0.0000"
Application.CutCopyMode = False
Sheets("Data").Select
Columns(5).EntireColumn.Delete
Sheets(tempval).Select
'this is for translation
Range("E3").Select
ActiveCell.Value = answerval
'this is for tabular design
Sheets(tempval).Select
Range("A2:E2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A1:F1").Select
ActiveCell.FormulaR1C1 = "Table By VBA Coding"
Columns("A:E").EntireColumn.AutoFit
Signal = False
End If
Sheets("Currencies").Select
Range(activecelladdress).Select
ActiveCell.Offset(1, 0).Select
Wend
Sheets("tempdata").Delete
MsgBox ("the number of sheets created is " & count)
Application.DisplayAlerts = False
End Sub
Function test1(ByVal userchoice As String) As String
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
ws.Name = "tempdata"
Dim s As String
Sheets("tempdata").Select
Range("E3").Select
ActiveCell.FormulaR1C1 = "=TEXT(NOW(),""ddd"")"
Dim todayval As String
s = ActiveCell.Value
ActiveCell.Value = ""
Dim answer As String
'Dim userchoice As String
'userchoice = InputBox("Please enter 0 for english,1 for french and other for spanish")
If userchoice = "0" Then
answer = transalte_using_vba(s, "en")
ElseIf userchoice = "1" Then
answer = transalte_using_vba(s, "fr")
Else
answer = transalte_using_vba(s, "es")
End If
test1 = answer
End Function
Function transalte_using_vba(str, langchoice) As String
' Tools Refrence Select Microsoft internet Control
Dim IE As Object, i As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String
Dim CLEAN_DATA
Set IE = CreateObject("InternetExplorer.application")
' TO CHOOSE INPUT LANGUAGE
inputstring = "auto"
' TO CHOOSE OUTPUT LANGUAGE
outputstring = langchoice
text_to_convert = str
'open website
IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:10"))
Do Until IE.ReadyState = 4
DoEvents
Loop
CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "", ""), "<")
For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
Next
IE.Quit
transalte_using_vba = result_data
End Function
No comments:
Post a Comment