Příspěvky uživatele

Standartně asi ne, ale dá se to obejít ...
1) Formátovat pouze pomocí makra, které si list odemkne, naformátuje a zase zamkne. V makru si pak ošetříte co a jak.
2) Nechat soubor odemčený, ale při eventu SelectionChange ověřit jestli má buňka vzorec, pokud ano, tak automaticky aktivovat jinou buňku bez vzorce. Čímž nikdo nebude moct změnit buňky se vzorcem, ale jinak může cokoliv. Nevýhodou je, že je potřeba ošetřit oblasti a případ kdy uživatel nepovolí makra.
3) Opět při eventu SelectionChange kontrolovat je-li daná buňka Locked a pokud ano, tak zamknout list, pokud ne, tak odemknout. Opět je potřeba ošetřit viz. bod 2.

A věřím že možností bude více, ale za mě bych se přikláněl k bodu 1.

M@

Třeba
následujícím dosazením...
Range("C5:C" & Application.WorksheetFunction.CountA(Range("B:B")))

Tak třeba takhle nějak ...

Dim rd As Single
Dim rdk As Single
rd = 23

Do While Cells(rd, 2) <> "KO za:"
rd = rd + 1
If Cells(rd, 2) = "KO za:" And rdk = 0 Then rdk = rd
If Cells(rd, 2) = "KO za:" And Cells(rd + 1, 2) <> "" Then rd = rd + 1
Loop

Range("B23:F" & rdk).Copy Range("B" & rd + 1)
Range("C" & rd + 1 & ":F" & rd + 17).ClearContents

První kvůli čemu to nebude fungovat asi bude chybějící "t" ve funkci CountIf.

Jinak ...
Application.ScreenUpdating = False
Dim iRow As Long

Dim ws As Worksheet
Set ws = Worksheets("List1")
iRow = Sheets("List1").UsedRange.Rows.Count + 1

''existuje už v databazi?
If WorksheetFunction.CountIf(ws.Range("A:A"), TextBox9.Value) > 0 Then
Select Case MsgBox("Faktura pod tímto číslem již existuje, Přejete si ji přepsat?" & vbNewLine & "ANO = Přepsat" & vbNewLine & "NE = Zrušit zápis", vbYesNo + vbQuestion, "UPOZORNĚNÍ")
Case vbYes
iRow = WorksheetFunction.Match(TextBox9.Value, ws.Range("A:A"), False)
Case vbNo, vbCancel
Exit Sub
End Select
End If

ws.Cells(iRow, 1).Value = Me.TextBox9
ws.Cells(iRow, 2).Value = Me.TextBox8
ws.Cells(iRow, 3).Value = Me.TextBox1
ws.Cells(iRow, 4).Value = Me.TextBox5
ws.Cells(iRow, 5).Value = Me.TextBox3
ws.Cells(iRow, 6).Value = Me.TextBox4
ws.Cells(iRow, 7).Value = Me.TextBox6
ws.Cells(iRow, 8).Value = CDbl(Me.TextBox7)
ws.Cells(iRow, 9).Value = Format(TextBox10.Value, "dd.mm.yyyy")

Call Main 'Progress Bar

MsgBox "Záznam byl uložen do vydaných faktur", vbApplicationModal + vbInformation, "POTVRZENÍ"
Application.ScreenUpdating = True
Unload Me
Sheets("List1").Select

M@

Chtělo by to přílohu.
Čím je definována část tabulky jenž se má kopírovat?

M@

Já to jen přeložím ... :-)
=PROČISTIT(ZPRAVA(A1;DÉLKA(A1)-NAJÍT("-";A1)))-PROČISTIT(ZLEVA(A1;NAJÍT("-";A1)-1))-B1/24

Třeba by se hodil slovník ...
http://office.lasakovi.com/excel/funkce/ms-excel-funkce-en-cz/
nebo http://www.jirikhun.cz/ceske-a-anglicke-nazvy-funkci-microsoft-excel/
M@

Jen takový čistě VBA pokus ...
Public Sub pokus()
Dim D1() As String
Dim D2() As String
Dim JeVD1 As String
Dim Jmena() As String
Dim ind As Boolean

D1 = Split("Karel,Pepa,Lojza,Jan,Marek,Ota", ",")
D2 = Split("Pepa,Lojza,Jan,Marek", ",")

For Each jm1 In D1
ind = False
For Each jm2 In D2
If jm1 = jm2 Then
ind = True
Exit For
End If
Next
If ind = False Then
JeVD1 = JeVD1 & jm1 & ","
End If
Next

Jmena = Split(JeVD1, ",")
If UBound(Jmena) > 0 Then
MsgBox "Počet Jmen chybějících v D2 = " & UBound(Jmena) & vbNewLine & vbNewLine & Join(Jmena, vbNewLine)
End If

End Sub
M@

Třeba vzorečkem - příloha.

M@

Co takhle dát uživateli na výběr, kam si to dočasné pdf uloží?
Dim cesta As String
cesta = Application.GetSaveAsFilename(InitialFileName:="Něco", fileFilter:="PDF (*.pdf), *.pdf")

Pokud si to ale chceš řídit sám, tak
Dim cesta As String
Cesta = Environ$("USERPROFILE") & "\Desktop\"
což se nemusí všem líbit a na starších Windows, to ani šlapat nemusí.

M@

Asi by to šlo maticovým vzorcem, ale s těma moc nekamarádím, takže bych bych funkci OR nevnořoval, ale udělal bych to přes součet několika COUNTIFů.

Co třeba obyčejný COUNTIF?

Tímto lze nastavit parametry na úrovni Wordu, pokud ale tiskárna má jako výchozí černobílý tisk, tak tento příkaz nic nezmění. Bohužel do vlastností tiskárny se z VBA jen tak dostat nelze, to už je vyšší úroveň programování.
Na odkaze níže řeší oboustranný tisk, z čehož plyne, že ani barevný tisk není nereálný :-), ale na mě už je to moc.

https://support.microsoft.com/cs-cz/help/828638/how-to-set-duplex-printing-for-microsoft-word-automation-clients
M@

Upřímně, mě nic moc nenapadá, když nám to jde :-).
Ještě mě napadlo, že by se mu mohlo nelíbit to že vlastnost visible se mění až po zamčení, ale i to projde.

Sheet1.Protect Password:= ...
Sheet1.Shapes.Range(Array("Obrázok 2")).Visible = msoFalse

Taková oblíbená IT rada - zkusit restart PC :-)

M@

Tady bych se zeptal jestli došlo ke správné instalaci / registraci daného ocx prvku? U sebe jsem neinstaloval tak nevím, ale je to to první co mě napadá.
Jinak způsobů jak vložit QR je více pomocí online doplňků, otázka jestli je to pro vás použitelné s nutností připojení na internet.

V příloze mám takový pokus, kde pomocí vlastní funkce vkládám obrázek s QR kódem, který negeneruji já, ale nechal jsem to online na googlu.

M@

To se obávám, že nelze, leda makrem automaticky přizpůsobit, ale pokud je v cílových souborech využito slučování buněk, či texty přes více buňěk, které tak jsou zamýšleny, tak to může spíš uškodit. Ale to už musíte vědět Vy.
V příloze je nástřel makra jenž nastaví automatickou šířku sloupců všech listů v souborech dodaných v seznamu.

M@

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje