Příspěvky uživatele

For Each cell In Selection
cell.Value = LCase(cell.Value)
Next

M@

Dim t As String
t = Application.InputBox("Zadej poznámku")
If t <> "" Then
Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) = t
End If

nebo

Dim t As String
Dim rd As Single 'řádek
Dim sl As Single 'sloupec

t = Application.InputBox("Zadej poznámku")

rd = 1 'začni prohledávat od řádku 1
sl = 1 'sloupec k prohledání a zápisu
If t <> "" Then
Do While Cells(rd, sl) <> ""
rd = rd + 1
Loop
Cells(rd, sl) = t
End If

M@

Souhlas!

M@

Jelikož mám jen office 2003, tak se můžu vyjádřit k němu.
Napíšu jen zjednodušenou verzi předpokládající, že se jedná o textové pole. (Datové a číselné musí být v dotazu řešeny jinak).
1) V referencích projektu je třeba přidat referenci na Microsoft ActiveX Data Objetcts 2.8 Library (použito v mém případě).
2) V databázi je potřeba mít nějaký jedinečný identifikátor (ID).
3) V tvém zobrazovacím dotazu budu předpokládat, že ID bude zobrazeno v prvním sloupci Excelu.
4) Kód pro úpravu hodnoty na základě změně excelové buňky (neřeší žádné ověřování apod.)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

Dim strConn, field As String
Dim db_id As Single

Dim conn As ADODB.Connection
Set conn = New ADODB.Connection

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\data.mdb;User Id=admin;Password=;"
conn.Open strConn

db_id = Cells(Target.Row, 1)
field = Cells(1, Target.Column)
conn.Execute "UPDATE TABULKA SET " & field & "='" & Target.Value & "' WHERE ID = " & db_id

conn.Close

Set rs = Nothing
Set conn = Nothing
End Sub

Vložení nového bude obdobné s tím rozdílem že proběhne ověření je-li v prvním sloupci ID, pokud bude buňka prázdná, tak by se předpokládalo že jde o nový záznam a SQL příkaz změníš na Insert Into TABULKA (Seznam polí) Select Seznam hodnot.

M@

Public Sub dopln()
For rd = 1 To List2.UsedRange.Rows.Count
lcol = 2
For rd2 = 1 To List1.UsedRange.Rows.Count
If List1.Cells(rd2, 1) = List2.Cells(rd, 1) Then
List2.Cells(rd, lcol) = List1.Cells(rd2, 2)
lcol = lcol + 1
End If
Next
Next
End Sub

M@

Nemám zapnutý excel, ale ve funkci last_r by mělo stačit změnit
rd2 = 2 na rd2 = 11

M@

Ahoj,

zkus do modulu vložit:
Public Function last_r()
Dim rd2 As Single
rd2 = 2
Do While Sheets("Hárok2").Cells(rd2, 1) <> ""
If Sheets("Hárok2").Cells(rd2, 1).HasFormula = True Then
Sheets("Hárok2").Rows(rd2).Insert
Exit Do
Else
rd2 = rd2 + 1
End If
Loop
last_r = rd2
End Function

Public Function kopiruj(r_from, r_to)
Sheets("Hárok1").Rows(r_from).Copy Sheets("Hárok2").Rows(r_to)
End Function

Public Sub kopiruj_a()
Dim rd As Single
rd = ActiveCell.Row
Call kopiruj(rd, last_r)
End Sub

Public Sub kopiruj_5()
Dim rd, rd2 As Single
rd2 = last_r
rd = 5
Call kopiruj(rd, rd2)
Sheets("Hárok2").Cells(rd2, 5) = Sheets("Hárok2").Range("J3")
End Sub
Tlačítko kopíruj aktivní řádek si pak nastavíš na makro kopiruj_a a tlačítko kopíruj 5. řádek nastavíš na kopiruj_5.

M@

třeba ...
Dim param As String
Dim rd2 As Single
param = InputBox("Zadej znak jehož výskyt mám hledat", "Parametr", "3")
If param = none Then Exit Sub
For rd = 2 To List1.UsedRange.Rows.Count
If InStr(1, Cells(rd, 1), param, vbTextCompare) <> 0 Then
rd2 = List2.UsedRange.Rows.Count + 1
List1.Rows(rd & ":" & rd).Copy List2.Rows(rd2 & ":" & rd2)
End If
Next

M@

Osobně pro ověření existence používám DIR:
If Dir("C:\TEST\test.xlsx") <> "" Then MsgBox "EXISTUJE" Else MsgBox "NEEXISTUJE"

M@

na začátek makra si vlož třeba:
on error goto x
a na konec těsně před to End Sub
vlož x:
případně před něj můžeš vložit i exit sub.

M@

Podle všeho asi ne - leda to obejít.
1) nahoře si vybrat pár řádků jenž budou sloužit jako záhlaví a budou se tisknout všude, což řeší jen záhlaví a nezamezí to nikomu vložit ještě záhlaví a zápatí vlastní.
2) Makrem do procedury BeforePrint nastavit vlastní záhlaví i zápatí, jinými slovy nezabráníš tomu aby si tam kdokoliv cokoliv napsal, ale vytisknout se vytiskne to co budeš chtít ty, protože se to před tiskem přepíše tím čím si určíš. No a makro zamknout lze.

První googlem nalezený příklad:
With ActiveSheet.PageSetup
.LeftHeader = "záhlaví"
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "zápatí"
.CenterFooter = ""
.RightFooter = ""
End With

Lepší to asi nebude.
M@

Možné je všechno jen pak ztrácíš přehled o pohybech, co kdy kolik.

Třeba pomůže příloha (office 2003)

M@

Zkus přílohu - buď pomůže, nebo ne :-)

kámen úrazu bude asi v tom, že se nejspíš pokoušíš daný vzorec dostat přímo do pole hodnoty v grafu - takhle to nejde - musíš si vytvořit pojmenovanou oblast pomocí dané funkce:
Vložit -> Název -> Definovat -> do pole odkaz na.. zadat tu funkci a název si zadat vlastní (třeba Hodnoty).
Ve zdrojových datek grafu pak do pole hodnoty zadáš už jen náze v té pojmenované oblasti:
=Grafy.xls!Hodnoty

Příklad ne z mé hlavy :-) v příloze.

M@

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje