Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno excel makro které vloží hodnoty do buněk

Zdravím, mám prosbu, potřeboval bych vytvořit makro, které by fungovalo následovně:

zakliknu si buňku(např. A10) (v praxi tam bude již vepsané číslo zakázky) poté co spustím makro tlačítkem, se stane že :

od té zakliknuté buňky(A10) mi to do další buňky vpravo (B10) vloží aktuální datum, do další buňky (C10) text "Vypracování el. sch." , do další buňky (D10) text "NOVÁK", a do buňky (F10) se zapíše Datum expedice: s tím že že objeví dialogové okno které se mě zeptá na vložení data(třeba 10.09.2018), takže v buňce (F10) bude "Datum expedice: 10.09.2018"

příklad: (A10)2018-01234, (B10)30.08.2018, (C10) Vypracování el. sch., (D10) Novák, (F10) Datum expedice: 10.09.2018

nějaké makro jsem už pomocí zaznamenání makra vysmyslel, ale samozřejmě mi vůbec nefunguje a potřebu odladit, nevím, jak udělat krok že se od aktivní buňky posunu o buňku vpravo
dále mám problém s tím dialogovým oknem, asi jsem použil špatný kód.... PŘEDEM DÍKY ZA POMOC

Sub Makro1()

Dim MojeRange As Range

ActiveCell.Select
Set MojeRange = Range(ActiveCell).Offset(0, 1)
MojeRange.Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Set MojeRange = Range(ActiveCell).Offset(0, 1)
MojeRange.Select
ActiveCell.FormulaR1C1 = "Vypracování el. sch."
Set MojeRange = Range(ActiveCell).Offset(0, 1)
MojeRange.Select
ActiveCell.FormulaR1C1 = "Novák"
Set MojeRange = Range(ActiveCell).Offset(0, 2)
MojeRange.Select
MojeHodnota = InputBox("Za dvojtečku dej mezeru a vlož aktuální dautm", "Datum expedice:", "Datum expedice:")
End Sub

Předmět Autor Datum
problém s activesell a posunutím vpravo jsme už vyřešil, ted bych potřeboval prosím pomoct s tím dia…
coffee black 30.08.2018 08:46
coffee black
Pro zapisování údajů nemusíš nastavovat Range a označovat buňky. Offset budeš postupně navyšovat (0,…
Jan Fiala 30.08.2018 08:50
Jan Fiala
ajo, máš pravdu, díky
coffee black 30.08.2018 08:51
coffee black
Nekomplikuj si život ;-) Sub AutDoplneni() If ActiveCell.Column <> 1 Then MsgBox "Nenacházíš se v s… poslední
robert13 30.08.2018 11:04
robert13
TAK JSEM SI NAKONEC PORADIL SÁM :) zde je makro Sub Makro1() ActiveCell.Select ActiveCell.Offset(…
coffee black 30.08.2018 08:50
coffee black

Pro zapisování údajů nemusíš nastavovat Range a označovat buňky.
Offset budeš postupně navyšovat (0, 1), (0, 2), (0, 3)
Pozor na vzorec =Today(), protože tím, že tam vložíš vzorec, tak tam budeš mít pokaždé aktuální datum. To nechceš. Musíš tam vložit hodnotu.

ActiveCell.Offset(0,1).Value=Date
ActiveCell.Offset(0,2).Value="Vypracování el. sch."
....

A ještě bys měl ošetřit to, že to nebudeš vyplňovat pokaždé, ale jen poprvé, dokud to nebude vyplněné

Nekomplikuj si život ;-)

Sub AutDoplneni()

    If ActiveCell.Column <> 1 Then
        MsgBox "Nenacházíš se v správné buňce!", vbExclamation, "Upozornění"
        Exit Sub
    End If
    
    With ActiveCell
        .Offset(0, 1) = Date
        .Offset(0, 2) = "Vypracování el.sch."
        .Offset(0, 3) = "Benetka"
        .Offset(0, 5) = "Datum expedice: " & InputBox("Vlož aktuální datum")
    End With
    
    Columns("A:F").EntireColumn.AutoFit

End Sub

P.S.

a)
Nie je jasné, čo myslíš tým doplnením aktuálneho dátumu, lebo "aktuálny" je dnešný a teda by sa pre stĺpec F nemusel pýtať InputBox-om ale tiež vložiť "= Date"
Ale potom čo za dátum bude v stĺpci "B" keďže aj tam si chcel pôvodne dať dnešný dátum funkciou TODAY.

b)
Píšeš "Novák" ale dávaš tam "Benetka"... tak ako?

c)
Dal som Ti tam kontrolu, či si nastavený v bunke stĺpca "A", lebo inak by sa to posunulo inam a tiež som doplnil automatické prispôsobenie šírok stĺpcov...

d)
Makro sa dá doplniť na blbuvzdornejšie, napr. kontrolou, či sa InputBoxom zadal skutočný dátum a pod, ale problematika dátumu je otázna, v zmysle bodu a)

TAK JSEM SI NAKONEC PORADIL SÁM :)

zde je makro

Sub Makro1()

ActiveCell.Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Vypracování el. sch."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Benetka"
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = InputBox("Za dvojtečku dej mezeru a vlož aktuální dautm", "Datum expedice:", "Datum expedice: ")

End Sub

Zpět do poradny Odpovědět na původní otázku Nahoru