mám vytvořený formulář UserForm a vytvořené makro. Spuštění přes kartu Vývojář/Makra/Moje_makro funguje bez problémů a po zadání hodnot je výstup generován na nový list. Při spuštění přes vytvořenou kartu Moje však nefunguje formátování a výsledek se ne a ne vypsat na nový list - navíc mi hodí hlášku error 400, kterou nejsem schopen odstranit..
Zkoušel jsem postupovat podle článku zde: http://excelplus.net/news.php?readmore=39, ale bohužel se nedaří...
kód v UserFormu:
Kód: Vybrat vše
Public Sub Button_Go_Click()
Dim Hodnota As Range
Dim Vaha As Range
Dim Cislo As Variant
Dim funkce As Variant
Dim vystup01 As Double
If DataH.text = "" Or DataV.text = "" Then
MsgBox ("Musíte zadat hodnoty pro pole 'Hodnota' i 'Vaha'")
Exit Sub
End If
Set Hodnota = Range(DataH.text)
Set Vaha = Range(DataV.text)
'ošetření proti zadávání nečíselných hodnot a prázdných buněk pro Hodnotu
For Each Cislo In Hodnota
If IsNumeric(Cislo) = False Or IsEmpty(Hodnota) Then
MsgBox ("Některé z hodnot nejsou číselné nebo jsou prázdné (pole Hodnota)")
Exit Sub
End If
Next Cislo
For Each Cislo In Vaha
If IsNumeric(Cislo) = False Or IsEmpty(Vaha) Then
MsgBox ("Některé z hodnot nejsou číselné nebo jsou prázdné (pole Vaha)")
Exit Sub
End If
Next Cislo
On Error GoTo 0
funkce = Vazenyprumer(Hodnota, Vaha)
vystup01 = funkce / 2
'vytvareni noveho listu pro vysledek makra (řešení#) - zavolání makra
Call NovyList
Call Vazenyprumer(Hodnota, Vaha)
'formatovani nadpisu v tabulce
Range("B2").Select
ActiveCell.FormulaR1C1 = "Vážený průměr"
With ActiveCell.Characters(Start:=1, Length:=30).Font
.Name = "Courier New"
.FontStyle = "Tučné"
.Size = 12
End With
'popisy hodnot v tabulce
Range("B4").Select
ActiveCell.FormulaR1C1 = "Vstupní pole Hodnota:"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Courier New"
.Size = 12
End With
Range("B5").Select
ActiveCell.FormulaR1C1 = "Vstupní pole Vaha:"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Courier New"
.Size = 12
End With
Range("B8").Select
ActiveCell.FormulaR1C1 = "Hodnota Váž. průměru:"
With ActiveCell.Characters(Start:=1, Length:=25).Font
.Name = "Courier New"
.Size = 12
End With
'vypise kombinaci prislusnych vystupu do bunek
Cells(4, 6).Value = Hodnota
Cells(5, 6).Select
With ActiveCell.Characters(Start:=1, Length:=25).Font
.Name = "Courier New"
.Size = 12
End With
Cells(5, 6).Value = vystup01
Cells(6, 6).Select
With ActiveCell.Characters(Start:=1, Length:=25).Font
.Name = "Courier New"
.Size = 12
End With
Cells(8, 6).Value = funkce
Cells(8, 6).Select
With ActiveCell.Characters(Start:=1, Length:=25).Font
.Name = "Courier New"
.Size = 12
End With
End Sub
Private Sub CommandButton1_Click()
Unload UserForm1
End SubKód (RibbonX) CustomUI:
Kód: Vybrat vše
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" loadImage="onLoadImage">
<ribbon startFromScratch="false">
<tabs>
<tab id="tabMoje" label="Moje" insertBeforeMso="TabHome" keytip="M">
<group id="grpTAP" label="TAP" keytip="T">
<menu id="ikona_tap" image="ikona_tap.PNG" size="large" itemSize="large" label="Zápočet" supertip="Obsahuje vybrané zápočtové práce předmětu Tabulkové aplikace">
<button id="ikona_vp" image="ikona_vp.PNG" label="Vážený průměr (Ctrl+Shift+V)" description="Vypočítá Vážený průměr" onAction="VazPrum()" />
</menu>
</group>
</tab>
</tabs>
</ribbon>
</customUI>Předem díky za odpověď
Piškot
