Příspěvky uživatele


< návrat zpět

Strana:  1 2 3 4 5 6 7 8 9   další » ... 42

A nešla by využít cesta k souboru?

CESTA = ThisWorkbook.Path

To vypadá jako moje makro. 5

Sub Import()

Dim CESTA As String
Dim SOUBOR As String
Dim ZDROJ As String
Dim CIL As String
Dim RADEK As Long
Dim POCET As Long
Dim wsDATA As Worksheet
Dim objNetwork As Object

Set wsDATA = Worksheets("List1")
Set objNetwork = CreateObject("WScript.Network")

PCN = objNetwork.ComputerName
Set objNetwork = Nothing

POCET = wsDATA.Cells(Rows.Count, "A").End(xlUp).Row

If POCET > 0 Then wsDATA.Range("A2").Resize(POCET, 3).ClearContents

MESIC = wsDATA.Range("E1")
CILMESIC = Sheets("Report").Range("B1")

CESTA = "C:\Users\" & PCN & "\Documents\MEGA\import\Report\"
ZDROJ = "Report " & MESIC & ".xlsx"
CIL = "Vyučtovanie " & CILMESIC & ".xlsm"

SOUBOR = CESTA & ZDROJ

If Dir(SOUBOR) = "" Then MsgBox "Soubor " & SOUBOR & " neexistuje!", vbCritical: Exit Sub

Application.ScreenUpdating = False
Workbooks.Open Filename:=SOUBOR
POCET = Workbooks(ZDROJ).Sheets("Položky dokladu").Cells(Rows.Count, "A").End(xlUp).Row - 2
Workbooks(CIL).Sheets("List1").Range("A2").Resize(POCET, 3).Value = Workbooks(ZDROJ).Sheets("Položky dokladu").Range("B3").Resize(POCET, 3).Value
Workbooks(ZDROJ).Close SaveChanges:=False
Application.ScreenUpdating = True

ActiveWorkbook.RefreshAll

End Sub

Sub makro()

Dim objNetwork As Object
Set objNetwork = CreateObject("WScript.Network")

PCN = objNetwork.ComputerName

Set objNetwork = Nothing

CESTA = "C:\Users\" & PCN & "\Documents\MEGA\import\Report"

End Sub

Já se tím už nezaobíral, když jsem viděl, že to máš hotové. 1

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Set KeyCells = Range("A1:C1")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

If Range("A1").Value > "" And Range("A1").Value = 0 And Range("B1").Value > "" And Range("B1").Value = 0 And Range("C1").Value > "" And Range("C1").Value = 0 Then
Range("D1").Interior.Color = vbRed
Else
Range("D1").Interior.Pattern = xlNone
End If

End If

End Sub

nevím jestli jsem to pochopil.

Private Sub CheckBox1_change()

If CheckBox1.Value = True Then

i = MsgBox("Při zapnutí dojde k vynulování všech uložených hodnot. Pokračovat?", vbYesNo + vbExclamation, "Varování!")
Select Case i
Case vbYes
Call Reset

Case vbNo
CheckBox1.Value = False
MsgBox "Bla bla", vbCritical
End Select

ElseIf CheckBox1.Value = False Then
Exit Sub
End If

End Sub

Jiří497 napsal/a:

Třeba takto:=KDYŽ(DENTÝDNE(A3;2)=6;KDYŽ(DEN(A3)<=6;SUMA(POSUN(M3;-(DEN(A3)-1);-2):K3);SUMA(POSUN(M3;-6;-2):K3));0)

Sčítá odpracovanou dobu od soboty do předchozí neděle.Příloha: 54224_54222_dochazka-nova.xlsx (19kB, staženo 0x)


Sakra předběhl jsi mě. 5

Nejde mi to stáhnout. zaregistruj se a dej přílohu sem.

Není za co. 1

Může být?

Není za co.

Ještě oprava zbarvení buněk.

číselníky nefundují dokud nejsou splněny podmínky.

Tvl já vůbec nerozumím co chceš. 8

Co se skrytí a zviditelnění číselníku týče.

skrýt:
Sheets("List1").Shapes("Spinner 1").Visible = False

zobrazit:
Sheets("List1").Shapes("Spinner 1").Visible = True

Jojo já už jsem si poradil, děkuji.


Strana:  1 2 3 4 5 6 7 8 9   další » ... 42

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Výmaz řádku podle hodnoty v konkrétním sloupci

elninoslov • 7.2. 21:49

Výmaz řádku podle hodnoty v konkrétním sloupci

Alfan • 7.2. 14:02

Výmaz řádku podle hodnoty v konkrétním sloupci

Alfan • 7.2. 11:44

plán 12 h směn na celý rok

PE1PA • 6.2. 14:56

plán 12 h směn na celý rok

elninoslov • 6.2. 14:16

plán 12 h směn na celý rok

elninoslov • 6.2. 14:15

plán 12 h směn na celý rok

elninoslov • 6.2. 13:21