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

Příspěvky uživatele

Jak píše Palooo,
jen bych to makro malinko poupravil, nepsalo HL pro první hodnotu
Sub aTest()
With ActiveSheet
For x = 1 To Cells(1, 1).CurrentRegion.Rows.Count
aValue = Split(.Cells(x, 25), ",")
For y = 0 To UBound(aValue)
.Hyperlinks.Add Anchor:=.Cells(x, 30 + y), Address:="http://www.ncbi.nlm.nih.gov/pubmed/?term=" & aValue(y), TextToDisplay:=aValue(y)
Next
Next
End With
End Sub

Třeba myslel Fullscreen jen normální přes celou obrazovku
Při otevření sešitu dát
Application.WindowState = xlMaximizedb
při zavření
Application.WindowState = xlNormal

S tou hláškou by to třeba šlo i tak že na začátku načítání dat by vyskočilo okno a na konci načítání by se dalo zavřít. Myslím ale že to samé už píše ve StatusBaru.

ad1)
Asi bych to udělal takto

Dim ChngRow As Integer
Dim ChngCell As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SrcRange As Range
Dim NewRow As Integer

'byla zmena a je vybran jiny radek od editovaneho?
If ChngCell = True And Not ActiveCell.Row = ChngRow Then

Set SrcRange = Range("A" & ChngRow & ":K" & ChngRow)

With Sheets("History")
NewRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & NewRow & ":K" & NewRow).Value = SrcRange.Value
.Range("L" & NewRow).Value = Now
.Range("M" & NewRow).Value = Environ("username")
End With
End If

ChngCell = False

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ChngRow = Target.Row
ChngCell = True
End Sub
Vlož do listu z kterého se bude kopírovat.

edit:
Ad2)
tak na začátek makra dej application.enableevents=false a na konec to same ale s true

Zkus kouknout tady na to
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Range("B8:B8")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
With Sheets("Lístek2").Range("A" & Rows.Count).End(xlUp)
.Offset(1) = KeyCells.Value
.Offset(1, 10) = Now
End With
End If
End Sub

Při změně buňky v nastavené oblasti se udaje překopírují do jiného listu.

Tak do jedné buňky se nedá dát více hypertextových odkazů - pouze jeden.

Tak toto dej do modulu listu "vyhledavani"
Private Sub Worksheet_Change(ByVal Target As Range)
'je zmena v pozadovane bunce?
If Target.Address = "$B$3" Then
Call Zobraz_tabulku
End If
End Sub
A to makro zobraz tabulku presun do obycejneho modulu

Jsou tam dvě malé chybky.
na řádku
Sheets("List2").Range("A2:A10000").ClearContents
má být
Sheets("List2").Range("A1:A10000").ClearContents

a řádku
Set oblast = Sheets("List2").Range("A2:A" & S)
má být
Set oblast = Sheets("List2").Range("A1:A" & S)

Pošli nějakou ukázku kde ti to dělá,
mě se to nepodařilo nasimulovat.

Nevím jaké to makro v předchozí příloze, ale třeba pomůže i toto
Sub HorniIndexAktivniBunka()
With ActiveCell.Characters(Start:=Len(ActiveCell.Text), Length:=1).Font
.Superscript = True
End With
End Sub
Dá jako horní index poslední znak v aktivni bunce.

použij fci KDYŽ , JE.CHYBA (excel2010 - nevím zda je stejné i třeba pro 2007), a SVYHLEDAT dohromady. Pak se Ti bude zobrazovat 0 když nic nenajde.

Tak na toto používám http://www.slunecnice.cz/sw/optimik/

Použij fci SVYHLEDAT.

Toto makro ti to bude splňovat.
v A1 je tisk od a v B1 tisk do.
Makro ti bude tisknout po jedné stránce, zároveň se bude měnit hodnota v A1.

Sub TiskFromTo()
'
Dim shFrom As Byte
Dim shTo As Byte
Dim x As Byte

shFrom = Range("A1")
shTo = Range("B1")

For x = shFrom To shTo
Range("A1") = shFrom
ActiveWindow.SelectedSheets.PrintOut From:=shFrom, To:=shFrom, Copies:=1
shFrom = shFrom + 1
Next x
End Sub

Na každém DL jsou asi jiné položky, je tak?
Jinak by stačil jen jeden a do toho psát.

Když se vyplní DL co se děje potom, dá se tisk nebo se někam odešle nebo co?

Na nějakou takovou událost se bude muset navázat aby se mohlo zvýšit číslo DL.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje