PC-HELP.CZ

final.xlsm: soubor excel 2007 (.xlsm); (40.01 KiB) Staženo 8 x

Dobrý den,
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 Sub

Kó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

PC-HELP.CZ

Ribbonx_Excel_2007

Ribbonx_Excel_2007