VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmRandomNumbers 
   Caption         =   "Generierung von Zufallszahlen"
   ClientHeight    =   6810
   ClientLeft      =   450
   ClientTop       =   840
   ClientWidth     =   7905
   OleObjectBlob   =   "frmRandomNumbers.frx":0000
   ShowModal       =   0   'False
End
Attribute VB_Name = "frmRandomNumbers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub cmd22Fill_Click()
' ==========================================================
' Fill ranges with random numbers
' The ranges must already be selected on the worksheet
' before starting this procedure
' ==========================================================

Dim rngCell As Range
Dim sngHelp As Single
Dim dblNumber As Double
Dim dblUpperLimit As Double
Dim dblLowerLimit As Double
Dim dblEmptyCells As Double
Dim dblNegativeNumbers As Double

' Check the upper limit

If txtUpperLimit.Value = "" Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Bitte eine Obergrenze eingeben!"
      Case "en"
         MsgBox "Please enter an upper limit!"
   End Select
   txtUpperLimit.SetFocus
   Exit Sub
End If

If Not IsNumeric(txtUpperLimit) Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Bitte eine Zahl für die Obergrenze eingeben!"
      Case "en"
         MsgBox "Please enter a number for the upper limit!"
   End Select
   txtUpperLimit.SetFocus
   Exit Sub
End If

' Check the lower limit

If txtLowerLimit.Value = "" Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Bitte eine Untergrenze eingeben!"
      Case "en"
         MsgBox "Please enter a lower limit!"
   End Select
   txtLowerLimit.SetFocus
   Exit Sub
End If

If Not IsNumeric(txtLowerLimit) Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Bitte eine Zahl für die Untergrenze eingeben!"
      Case "en"
         MsgBox "Please enter a number for the lower limit!"
   End Select
   txtLowerLimit.SetFocus
   Exit Sub
End If

' Upper limt <= lower limt?

If CDbl(txtUpperLimit) <= CDbl(txtLowerLimit) Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Die Obergrenze darf nicht kleiner als die Untergrenze sein!"
      Case "en"
         MsgBox "The upper limit must not be smaller than the lower limit!"
   End Select
   Exit Sub
End If

' Check percentage of empty cells

If txtEmptyCells = "" Then txtEmptyCells = 0

If Not IsNumeric(txtEmptyCells) Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Bitte eine Zahl für den Anteil leerer Zellen eingeben!"
      Case "en"
         MsgBox "Please enter a number for the percentage of empty cells!"
   End Select
   txtEmptyCells.SetFocus
   Exit Sub
End If

If CDbl(txtEmptyCells) > 100 Then txtEmptyCells = 100
If CDbl(txtEmptyCells) < 0 Then txtEmptyCells = CStr(-1 * CDbl(txtEmptyCells))

' Check percentage of negative numbers

If txtNegativeNumbers = "" Then txtNegativeNumbers = 0

If Not IsNumeric(txtNegativeNumbers) Then
   Select Case txtLanguage
      Case "de"
         MsgBox "Bitte eine Zahl für den Anteil negativer Zahlen eingeben!"
      Case "en"
         MsgBox "Please enter a number for the percentage of negative numbers!"
   End Select
   txtNegativeNumbers.SetFocus
   Exit Sub
End If

If CDbl(txtNegativeNumbers) > 100 Then txtNegativeNumbers = 100
If CDbl(txtNegativeNumbers) < 0 Then txtNegativeNumbers = CStr(-1 * CDbl(txtNegativeNumbers))

' Change text to numbers

dblLowerLimit = CDbl(txtLowerLimit)
dblUpperLimit = CDbl(txtUpperLimit)
dblEmptyCells = CDbl(txtEmptyCells)
dblNegativeNumbers = CDbl(txtNegativeNumbers)

' Initialize the random number generator

Randomize

For Each rngCell In Selection   ' Loop over all cells of the selected range
   
   ' Integer or real number?

   If chkIntegers Then
      dblNumber = Int((dblUpperLimit - dblLowerLimit + 1) * Rnd + dblLowerLimit)
   Else
      dblNumber = (dblUpperLimit - dblLowerLimit) * Rnd + dblLowerLimit
   End If

   ' Generation of negative numbers
         
   sngHelp = Rnd
   If sngHelp < dblNegativeNumbers / 100 Then dblNumber = -1 * dblNumber

   ' Generation of empty cells
         
   sngHelp = Rnd
   If sngHelp < dblEmptyCells / 100 Then
      rngCell = ""
   Else
      rngCell = dblNumber
   End If
   
Next rngCell

End Sub

Private Sub cmd23Clear_Click()
' ==========================================================
' Clear the selected range

Dim rngCell As Range

For Each rngCell In Selection
   rngCell = ""
Next rngCell

End Sub

Private Sub imgEnglish_Click()
' ==========================================================
Call asSetLanguage(Me, "en")
txtLanguage = "en"
End Sub

Private Sub imgGerman_Click()
' ==========================================================
Call asSetLanguage(Me, "de")
txtLanguage = "de"
End Sub

Private Sub UserForm_Activate()
' ==========================================================
Call asSetLanguage(Me, "de")
txtLanguage = "de"
txtUpperLimit.SetFocus
End Sub

'######################################################################################
'######################################################################################
' A P P L I C A T I O N    S P E C I F I C    S U P P O R T    P R O C E D U R E S
'######################################################################################
'######################################################################################

Private Sub asSetLanguage(ByRef frmMe, _
                          strLanguage As String)
' =====================================================================================
' Sets the captions of all labels, buttons, ... on the form.
' The label names must have the form "lblxxYyyyy" where
' xx     is a number starting with 10 (11, 12, 13, ...)
' Yyyy   is the name of the label.

' "frmMe" is a reference to the user form that is calling this sub!
' Source for the trick with the parameter "ByRef frmMe":
' http://forums.devx.com/showthread.php?143192-VBA-passing-a-UserForm-as-a-parameter

Dim ctl As Control
Dim lngLabelNr As Long
Dim lngMultiPageNr As Long
Dim strLabels() As String
Dim strCodeFileName As String

'---------------------------------------------------
On Error GoTo Errorhandling
Dim strCodePosition As String
strCodePosition = "begin / " & frmMe.Name & " / " & strLanguage
'---------------------------------------------------

' The numbers of rows and columns is not defined in the Dim statement.
' Instead of, Dim defines strLables as a "general array with some rows and columns".
' Then, ReDim is used to set the number of rows an columns.

Const lngNrOfLabels = 100
ReDim strLabels(1 To lngNrOfLabels, 1 To 4) As String

' The array strLabels has four columns, because the third
' and the fourth column are needed for toggle buttons, which
' need two labels in each language - one if they are not
' pressed and one if they are pressed!

strLabels(1, 1) = "Generierung von"
strLabels(1, 2) = "Generation of"
strLabels(10, 1) = "Zufallszahlen"
strLabels(10, 2) = "Random numbers"
strLabels(11, 1) = ""
strLabels(11, 2) = ""
strLabels(12, 1) = ""
strLabels(12, 2) = ""
strLabels(13, 1) = ""
strLabels(13, 2) = ""
strLabels(14, 1) = "Bitte wählen Sie ZUERST einen oder mehrere (auch nicht zusammenhängende!) Zellbereiche auf dem Excel-Blatt aus, geben Sie die Parameter hier auf dem Formular ein und klicken Sie DANN auf 'Bereich(e) füllen'!"
strLabels(14, 2) = "Please select FIRST one or several (not necessarily connected) ranges on the Excel worksheet, enter the parameters here in this form and THEN click 'fill range(s)'!"
strLabels(15, 1) = "Obergrenze:"
strLabels(15, 2) = "upper limit:"
strLabels(16, 1) = "Untergrenze:"
strLabels(16, 2) = "lower limit:"
strLabels(17, 1) = "Leerzellen:"
strLabels(17, 2) = "empty cells:"
strLabels(18, 1) = "Negative Zahlen:"
strLabels(18, 2) = "negative numbers:"
strLabels(19, 1) = "Nur ganze Zahlen?"
strLabels(19, 2) = "integer numbers only?"
strLabels(20, 1) = "Für Datumsangaben: 1.1.2018 = 43101"
strLabels(20, 2) = "for dates: 2018-01-01 = 43101"
strLabels(21, 1) = "1.1.2019 = 43466"
strLabels(21, 2) = "2019-01-01 = 43466"
strLabels(22, 1) = "Bereich(e) füllen"
strLabels(22, 2) = "fill range(s)"
strLabels(23, 1) = "Bereich(e) leeren"
strLabels(23, 2) = "clear range(s)"

strCodePosition = "1 / " & frmMe.Name & " / " & strLanguage
   
' Set the form name

Select Case strLanguage
   Case "de"
      frmMe.Caption = strLabels(1, 1)
   Case "en"
      frmMe.Caption = strLabels(1, 2)
End Select

' Go through all rows of the array strLabels (starting with 10)
' Then, for each row go through all controls of the form and check,
' if the name of the control contains the number of the row.
' If yes, set the caption of the control.

For lngLabelNr = 10 To lngNrOfLabels   ' Loop over all entries in strLabels
   
   strCodePosition = "2 / " & frmMe.Name & " / " & Str(lngLabelNr)

   For Each ctl In frmMe.Controls   ' Loop over all controls on the form
      
      strCodePosition = "3 / " & frmMe.Name & " / " & Str(lngLabelNr) & " / " & ctl.Name
      
      ' Is the control a multipage control?
         
      If TypeOf ctl Is MSForms.MultiPage Then
         For lngMultiPageNr = 0 To ctl.Count - 1   ' Loop over all pages of the multipage
            If Mid(ctl.Pages(lngMultiPageNr).Name, 4, 2) = Trim(Str(lngLabelNr)) Then
               Select Case strLanguage
                  Case "de"
                     ctl.Pages(lngMultiPageNr).Caption = strLabels(lngLabelNr, 1)
                  Case "en"
                     ctl.Pages(lngMultiPageNr).Caption = strLabels(lngLabelNr, 2)
               End Select
            End If
         Next lngMultiPageNr
      End If
         
      strCodePosition = "4 / " & frmMe.Name & " / " & Str(lngLabelNr) & " / " & ctl.Name
         
      ' Is the control a label, a frame, an option button, a checkbox or a command button?
         
      If TypeOf ctl Is MSForms.Label Or _
         TypeOf ctl Is MSForms.Frame Or _
         TypeOf ctl Is MSForms.OptionButton Or _
         TypeOf ctl Is MSForms.CheckBox Or _
         TypeOf ctl Is MSForms.CommandButton Then
         If Mid(ctl.Name, 4, 2) = Trim(Str(lngLabelNr)) Then
            Select Case strLanguage
               Case "de"
                  ctl.Caption = strLabels(lngLabelNr, 1)
               Case "en"
                  ctl.Caption = strLabels(lngLabelNr, 2)
            End Select
         End If
      End If
         
      strCodePosition = "5 / " & frmMe.Name & " / " & Str(lngLabelNr) & " / " & ctl.Name
         
      ' Is the control a toggle button?
      
      If TypeOf ctl Is MSForms.ToggleButton Then
         If Mid(ctl.Name, 4, 2) = Trim(Str(lngLabelNr)) Then
            If ctl.Value = True Then   ' Button was pressed ("down")
               Select Case strLanguage
                  Case "de"
                     ctl.Caption = strLabels(lngLabelNr, 1)
                  Case "en"
                     ctl.Caption = strLabels(lngLabelNr, 2)
               End Select
            Else                       ' Button was not pressed ("up")
               Select Case strLanguage
                  Case "de"
                     ctl.Caption = strLabels(lngLabelNr, 3)
                  Case "en"
                     ctl.Caption = strLabels(lngLabelNr, 4)
               End Select
            End If
         End If
      End If
         
      strCodePosition = "6 / " & frmMe.Name & " / " & Str(lngLabelNr) & " / " & ctl.Name
         
   Next ctl   ' End of loop over all controls
      
Next lngLabelNr   ' End of loop over all entries in strLabels

' -------------------------------------------------------------------------------------
strCodePosition = "end / " & frmMe.Name & " / " & strLanguage
Exit Sub
Errorhandling:
' -------------------------------------------------------------------------------------
MsgBox "Date:" & Date & vbCrLf & _
       "Program version " & lblVersion2.Caption & vbCrLf & _
       "Procedure: asSetLanguage" & vbCrLf & _
       "Code position: " & strCodePosition & vbCrLf & _
       "Error number: " & Err.Number & vbCrLf & _
       "Error description: " & Err.Description & vbCrLf & _
       "Excel version:" & Application.Version
' -------------------------------------------------------------------------------------

End Sub

