• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Excel - úprava makra

Zaslal/a wertigo 14.2.2017 14:34

Ahoj všem

V práci jsem "podědil" generátor testových otázek v excelu a potřeboval bych radu. Makro dělá to, že náhodně generuje ze seznamu otázek a odpovědí, které jsou na jednom listu test. Tento vygenerovaný přenese jako podklad k tisku na další list. Problém je, pokud délka otázky nebo odpovědi přesáhne 265 (266?) znaků. V tomto případě se sice vše vygeneruje správně, ale text se ořízne na tuto hodnotu. Poradil by někdo kde a jak makro upravit prosím?
Makro níže:

Public Radek As Integer
Public Radek2 As Integer
Public Radek3 As Integer
Public Otazka As Integer

Function MySort()
Worksheets("Tem­p").Sort.SortFi­elds.Clear
Worksheets("Tem­p").Sort.SortFi­elds.Add Key:=Range("A1"), _
SortOn:=xlSor­tOnValues, Order:=xlAscending, DataOption:=xlSor­tNormal
With Worksheets("Tem­p").Sort
.SetRange Range("A1:B500")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Function

Function Okruh(NazevOkruhu, PocetOtazek)
Randomize
Worksheets("Tem­p").Range("A1:B500"­).ClearConten­ts
Worksheets(Na­zevOkruhu).Ran­ge("I1:L500")­.ClearContents
J = 0
For I = 1 To 500
Adr = I + 3
If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 1).Value = 1 Then
MaxPocet = 0
Chyba = 0
If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 5).Value > "" Then
MaxPocet = MaxPocet + 1
End If
If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 6).Value > "" Then
If MaxPocet = 0 Then Chyba = 1
MaxPocet = MaxPocet + 1
End If
If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 7).Value > "" Then
If MaxPocet < 2 Then Chyba = 1
MaxPocet = MaxPocet + 1
End If
If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 8).Value > "" Then
If MaxPocet < 3 Then Chyba = 1
MaxPocet = MaxPocet + 1
End If
If MaxPocet < 2 Then
Chyba = 1
End If

If Chyba = 1 Then
Sheets("Main")­.Select
Response = MsgBox("Zkontro­lujte, prosím, soubor otázek: " + NazevOkruhu + "!" + Chr(13) + "Některé otázky májí chybně zadané odpovědí.")
Exit Function
End If

Randomize
Poradi = Int(999999 * Rnd)
Worksheets(Na­zevOkruhu).Ce­lls(Adr, 9).Value = Poradi
Spravna = Int(MaxPocet * Rnd + 1)
Worksheets(Na­zevOkruhu).Ce­lls(Adr, 10).Value = Spravna
Worksheets(Na­zevOkruhu).Ce­lls(Adr, 11).Value = MaxPocet
Worksheets(Na­zevOkruhu).Ce­lls(Adr, 9).Value = Poradi

J = J + 1
Worksheets("Tem­p").Cells(J, 1).Value = Poradi
Worksheets("Tem­p").Cells(J, 2).Value = I
End If
Next I

MyTemp = MySort()
For II = 1 To PocetOtazek
Adr2 = Worksheets("Tem­p").Cells(II, 2).Value + 3
Worksheets(Na­zevOkruhu).Ce­lls(Adr2, 12).Value = 1
Next II
If J < PocetOtazek Then
Sheets("Main")­.Select
Response = MsgBox("Zkontro­lujte, prosím, soubor otázek: " + NazevOkruhu + "!" + Chr(13) + "Počet otázek není postačující.")
Exit Function
End If
End Function
Function TiskOkruh(Naze­vOkruhu, CisloOkruhu)
Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = "Okruh otázek: " + Format(Workshe­ets("Main").Ce­lls(6 + 5 * CisloOkruhu, 3).Value)
Worksheets("Tis­k1").Cells(Ra­dek, 1).Font.Italic = True
Worksheets("Tis­k1").Cells(Ra­dek, 1).Font.Size = 12

Worksheets("Tis­k2").Cells(Ra­dek2, 1).Value = "Okruh otázek: " + Format(Workshe­ets("Main").Ce­lls(6 + 5 * CisloOkruhu, 3).Value)
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Italic = True
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Size = 12

Radek = Radek + 2
Radek2 = Radek2 + 2
Radek3 = Radek3 + 1
For I = 1 To 500
Adr = I + 3
If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 12).Value = 1 Then
Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = Format(Otazka) + ". " + Format(Trim(Wor­ksheets(NazevO­kruhu).Cells(A­dr, 4).Value))
Worksheets("Tis­k1").Cells(Ra­dek, 1).Font.Size = 12
Worksheets("Tis­k1").Cells(Ra­dek, 1).Font.Bold = True

Worksheets("Tis­k2").Cells(Ra­dek, 1).Value = Format(Otazka) + ". " + Format(Trim(Wor­ksheets(NazevO­kruhu).Cells(A­dr, 4).Value))
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Size = 12
Worksheets("Tis­k2").Cells(Ra­dek, 1).Font.Bold = True

Radek = Radek + 1
Radek2 = Radek2 + 1

MaxOd = Worksheets(Na­zevOkruhu).Ce­lls(Adr, 11).Value
Spravne = Worksheets(Na­zevOkruhu).Ce­lls(Adr, 10).Value

Odpov1 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 5).Value)
Odpov2 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 6).Value)
Odpov3 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 7).Value)
Odpov4 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 8).Value)

If Spravne = 2 Then
Odpov1 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 6).Value)
Odpov2 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 5).Value)
End If

If Spravne = 3 Then
Odpov1 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 7).Value)
Odpov3 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 5).Value)
End If

If Spravne = 4 Then
Odpov1 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 8).Value)
Odpov4 = Trim(Worksheet­s(NazevOkruhu)­.Cells(Adr, 5).Value)
End If

Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = " a) " + Format(Odpov1)
Radek = Radek + 1
Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = " b) " + Format(Odpov2)
Radek = Radek + 1

Worksheets("Tis­k2").Cells(Ra­dek2, 1).Value = " a) " + Format(Odpov1)
If Spravne = 1 Then Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Color = RGB(0, 0, 255)
Radek2 = Radek2 + 1
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Value = " b) " + Format(Odpov2)
If Spravne = 2 Then Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Color = RGB(0, 0, 255)
Radek2 = Radek2 + 1

If MaxOd > 2 Then
Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = " c) " + Format(Odpov3)
Radek = Radek + 1
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Value = " c) " + Format(Odpov3)
If Spravne = 3 Then Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Color = RGB(0, 0, 255)
Radek2 = Radek2 + 1
End If

If MaxOd > 3 Then
Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = " d) " + Format(Odpov4)
Radek = Radek + 1
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Value = " d) " + Format(Odpov4)
If Spravne = 4 Then Worksheets("Tis­k2").Cells(Ra­dek2, 1).Font.Color = RGB(0, 0, 255)
Radek2 = Radek2 + 1
End If

Radek = Radek + 1
Radek2 = Radek2 + 1

If Worksheets(Na­zevOkruhu).Ce­lls(Adr, 13).Value > "" Then
Worksheets("Tis­k1").Cells(Ra­dek, 1).Value = Format(Workshe­ets(NazevOkru­hu).Cells(Adr, 13).Value)
Radek = Radek + 2
Worksheets("Tis­k2").Cells(Ra­dek2, 1).Value = Format(Workshe­ets(NazevOkru­hu).Cells(Adr, 13).Value)
Radek2 = Radek2 + 2
End If

If Spravne = 1 Then SpravneLetter = "a"
If Spravne = 2 Then SpravneLetter = "b"
If Spravne = 3 Then SpravneLetter = "c"
If Spravne = 4 Then SpravneLetter = "d"

If ((Otazka > 0) And (Otazka < 18)) Then
SloupecTisk = 1 + Spravne
RowTisk = 14 + Otazka
End If

If ((Otazka > 17) And (Otazka < 35)) Then
SloupecTisk = 6 + Spravne
RowTisk = 14 + Otazka - 17
End If

If (Otazka > 34) Then
SloupecTisk = 11 + Spravne
RowTisk = 14 + Otazka - 34
End If

Worksheets("Tis­k4").Cells(Row­Tisk, SloupecTisk).Fon­t.Bold = True
Worksheets("Tis­k4").Cells(Row­Tisk, SloupecTisk).In­terior.Color = RGB(255, 0, 0)

If (Otazka = 6) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If
If (Otazka = 13) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If
If (Otazka = 20) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If
If (Otazka = 27) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If
If (Otazka = 34) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If
If (Otazka = 41) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If
If (Otazka = 48) Then
Worksheets("Tis­k1").HPageBre­aks.Add Before:=Cells(Ra­dek, 1)
Worksheets("Tis­k2").HPageBre­aks.Add Before:=Cells(Ra­dek2, 1)
End If

Radek3 = Radek3 + 1
Otazka = Otazka + 1

End If
Next I
Radek = Radek + 1
Radek2 = Radek2 + 1
End Function

Sub newtest()

Sheets("Temp")­.Select

Dim NumberTest
Dim J
Prubezne = 0

Worksheets("Tis­k1").Unprotect ("1234")
Worksheets("Tis­k2").Unprotect ("1234")
Worksheets("Tis­k3").Unprotect ("1234")
Worksheets("Tis­k4").Unprotect ("1234")

Worksheets("Tis­k1").ResetAllPa­geBreaks
Worksheets("Tis­k2").ResetAllPa­geBreaks
Worksheets("Tis­k3").ResetAllPa­geBreaks
Worksheets("Tis­k4").ResetAllPa­geBreaks

Worksheets("Tis­k1").Range("A2:F1000­").ClearConten­ts
Worksheets("Tis­k1").Range("A2:F1000­").ClearFormats
Worksheets("Tis­k1").Columns(1)­.ColumnWidth = 100
Worksheets("Tis­k1").Range("A2:F1000­").Font.Bold = False
Worksheets("Tis­k1").Range("A2:F1000­").Font.Italic = False
Worksheets("Tis­k1").Range("A2:F1000­").Font.Color = RGB(0, 0, 0)
Worksheets("Tis­k1").Range("A2:F1000­").Font.Name = "Times New Roman"

Worksheets("Tis­k2").Range("A2:F1000­").ClearConten­ts
Worksheets("Tis­k2").Range("A2:F1000­").ClearFormats
Worksheets("Tis­k2").Columns(1)­.ColumnWidth = 100
Worksheets("Tis­k2").Range("A2:F1000­").Font.Bold = False
Worksheets("Tis­k2").Range("A2:F1000­").Font.Italic = False
Worksheets("Tis­k2").Range("A2:F1000­").Font.Color = RGB(0, 0, 0)
Worksheets("Tis­k2").Range("A2:F1000­").Font.Name = "Times New Roman"

NumberTest = Time + Date

PocetOtazek = Worksheets("Ma­in").Cells(12, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh1", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(17, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh2", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(22, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh3", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(27, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh4", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(32, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh5", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(37, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh6", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(42, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh7", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(47, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh8", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(52, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh9", PocetOtazek)

PocetOtazek = Worksheets("Ma­in").Cells(57, 3).Value
If PocetOtazek > 0 Then RetVal = Okruh("Okruh10", PocetOtazek)

Worksheets("Tis­k1").Range("A2:C2")­.HorizontalAlig­nment = xlCenter
Worksheets("Tis­k2").Range("A2:C2")­.HorizontalAlig­nment = xlCenter
Worksheets("Tis­k1").Range("A3:C1000­").HorizontalA­lignment = xlLeft
Worksheets("Tis­k2").Range("A3:C1000­").HorizontalA­lignment = xlLeft
Worksheets("Tis­k1").Range("A3:C1000­").VerticalAlig­nment = xlTop
Worksheets("Tis­k2").Range("A3:C1000­").VerticalAlig­nment = xlTop

Worksheets("Tis­k1").Range("A2:C1000­").Font.Size = 10
Worksheets("Tis­k2").Range("A2:C1000­").Font.Size = 10

Worksheets("Tis­k1").Rows("2:1000")­.RowHeight = 15
Worksheets("Tis­k2").Rows("2:1000")­.RowHeight = 15

Worksheets("Tis­k1").Range("A2:F1000­").WrapText = True
Worksheets("Tis­k2").Range("A2:F1000­").WrapText = True

Worksheets("Tis­k1").Cells(2, 1).Value = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value)
Worksheets("Tis­k1").Cells(2, 1).Font.Bold = True
Worksheets("Tis­k1").Cells(2, 1).Font.Size = 22
Worksheets("Tis­k1").Cells(4, 1).Value = Format(Workshe­ets("Main").Ce­lls(4, 3).Value)
Worksheets("Tis­k1").Cells(4, 1).Font.Bold = True
Worksheets("Tis­k1").Cells(4, 1).Font.Size = 16

Worksheets("Tis­k2").Cells(2, 1).Value = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value)
Worksheets("Tis­k2").Cells(2, 1).Font.Bold = True
Worksheets("Tis­k2").Cells(2, 1).Font.Size = 22
Worksheets("Tis­k2").Cells(4, 1).Value = Format(Workshe­ets("Main").Ce­lls(4, 3).Value)
Worksheets("Tis­k2").Cells(4, 1).Font.Bold = True
Worksheets("Tis­k2").Cells(4, 1).Font.Size = 16

Worksheets("Tis­k3").Cells(3, 1).Value = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value)
Worksheets("Tis­k4").Cells(3, 1).Value = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value)

Worksheets("Tis­k4").Range("B15:D31"­).Font.Bold = False
Worksheets("Tis­k4").Range("B15:D31"­).Interior.Co­lor = RGB(255, 255, 255)

Worksheets("Tis­k4").Range("G15:I31"­).Font.Bold = False
Worksheets("Tis­k4").Range("G15:I31"­).Interior.Co­lor = RGB(255, 255, 255)

Worksheets("Tis­k4").Range("L15:N30"­).Font.Bold = False
Worksheets("Tis­k4").Range("L15:N30"­).Interior.Co­lor = RGB(255, 255, 255)

Radek = 6
Radek2 = 6
Radek3 = 12
Otazka = 1

PocetOtazek = Worksheets("Ma­in").Cells(12, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh1", 1)

PocetOtazek = Worksheets("Ma­in").Cells(17, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh2", 2)

PocetOtazek = Worksheets("Ma­in").Cells(22, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh3", 3)

PocetOtazek = Worksheets("Ma­in").Cells(27, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh4", 4)

PocetOtazek = Worksheets("Ma­in").Cells(32, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh5", 5)

PocetOtazek = Worksheets("Ma­in").Cells(37, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh6", 6)

PocetOtazek = Worksheets("Ma­in").Cells(42, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh7", 7)

PocetOtazek = Worksheets("Ma­in").Cells(47, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh8", 8)

PocetOtazek = Worksheets("Ma­in").Cells(52, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh9", 9)

PocetOtazek = Worksheets("Ma­in").Cells(52, 3).Value
If PocetOtazek > 0 Then RetVal = TiskOkruh("Okruh10", 10)

Worksheets("Tis­k1").Range("A2:F1000­").Rows.AutoFit
Worksheets("Tis­k2").Range("A2:F1000­").Rows.AutoFit

Worksheets("Tis­k1").Range("A2:F1000­").VerticalAlig­nment = xlCenter
Worksheets("Tis­k2").Range("A2:F1000­").VerticalAlig­nment = xlCenter

With Worksheets("Tis­k1").PageSetup
.CenterHeader = ""
.CenterFooter = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value) + " / Vygenerováno: " + Format(Workshe­ets("Main").Ce­lls(5, 3).Value) + " / Stránka &P z &N"
End With
With Worksheets("Tis­k2").PageSetup
.CenterHeader = ""
.CenterFooter = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value) + " / Vygenerováno: " + Format(Workshe­ets("Main").Ce­lls(5, 3).Value) + " / Stránka &P z &N"
End With
With Worksheets("Tis­k3").PageSetup
.CenterHeader = ""
.CenterFooter = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value) + " / Vygenerováno: " + Format(Workshe­ets("Main").Ce­lls(5, 3).Value)
End With
With Worksheets("Tis­k4").PageSetup
.CenterHeader = ""
.CenterFooter = "TEST č." + Format(Workshe­ets("Main").Ce­lls(7, 3).Value) + " / Vygenerováno: " + Format(Workshe­ets("Main").Ce­lls(5, 3).Value)
End With

Worksheets("Tis­k1").Protect Password:="1234", DrawingObjects:=Tru­e, Contents:=True, Scenarios:=True
Worksheets("Tis­k2").Protect Password:="1234", DrawingObjects:=Tru­e, Contents:=True, Scenarios:=True
Worksheets("Tis­k3").Protect Password:="1234", DrawingObjects:=Tru­e, Contents:=True, Scenarios:=True
Worksheets("Tis­k4").Protect Password:="1234", DrawingObjects:=Tru­e, Contents:=True, Scenarios:=True

Sheets("Main")­.Select
Response = MsgBox("Test byl vygenerován!" + Chr(13) + "Vytisknete listy: Tisk1, Tisk2, Tisk3 a Tisk4.")
End Sub

Děkuju za každou radu.
Honza

Zaslat odpověď >

---

Pavlus(14.2.2017 14:47)#034942

Zkus vložit excelovou přílohu.
P.citovat

wertigo(14.2.2017 14:57)#034943

Tady je - přejmenovat koncovku na .xlsm (jsem v práci a txt je jediný formát co můžu poslat)

Příloha: 34943_testy-okruh-b-zakladni.txt (167kB, staženo 35x)

citovat

Pavlus(15.2.2017 18:35)#034957

Používá se tam funkce Format, která má výstup limitovaný na 255 znaků.

K vyřešení problému s dlouhými názvy otázek tak bude stačit pouze nahradit toto (v kódu dvakrát): Format(Trim(Worksheets(NazevOkruhu).Cells(Adr, 4).Value))tímto:
Trim(Worksheets(NazevOkruhu).Cells(Adr, 4).Value)Pro ošetření délky odpovědí pak analogicky provést úpravy v dalších příkazech...
P.citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje