Příspěvky uživatele


< návrat zpět

V kartě > Elektrotrend > Nastavení lze upravit adresářovou strukturu a následně simulovat chování.

Je to trochu oholené, funkcí už je hodně a bylo by to nepřehledné.

Podstatné zůstalo.

Dobrý den,

napsal jsem si funkci pro ověřování existence složky na disku.
Cesty jsou generované excelem a vše je plně funkčí.

Poprosil bych, zdy by někdo koukl a případně předal nějaké připomínky.

Děkuji.



Function KontrolaExistenceSlozkyZakazky()

Dim cell As Range
Dim rng As Range

'Definování Aktivního řádku
R = ActiveCell.Row

'Proměné
VyrobniCisloRozvadece = Cells(R, 1)
ZakaznikAkce = Cells(R, 2)
AktualniRok = Format(Now, "yyyy")
ZakazkoveCislo = Mid(VyrobniCisloRozvadece, 1, 4)

OdstranMezeruZakaznikAkce = WorksheetFunction.Trim(ZakaznikAkce)
CistyTvarZakaznikAkce = KontrolaZnaku("" & OdstranMezeruZakaznikAkce & "")

Sheets("Config").Visible = True

ZvolenyAdresar = Workbooks(ZakazkovaKniha).Sheets("Config").Range("route_disc")

Sheets("Temp").Visible = True
Application.ScreenUpdating = False
Workbooks(ZakazkovaKniha).Sheets("Temp").Activate
ActiveSheet.Range("F1").Select


Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(ZvolenyAdresar)
Set fc = f.SubFolders
For Each f1 In fc
polozka = f1.Name

ActiveCell.Value = polozka
ActiveCell.Offset(1, 0).Select

Next
Range("F:F").Find("System Volume Information").Delete Shift:=xlUp

PosledniPlnyRadek = Cells(Rows.Count, "F").End(xlUp).Row + 1 ' Ve sloupci F



Set rng = Workbooks(ZakazkovaKniha).Sheets("Temp").Range("F1:F" & PosledniPlnyRadek & "")

Workbooks(ZakazkovaKniha).Sheets("Kniha zakázek").Activate

For Each cell In rng

UmisteniSlozkyZakazkyArr = ZvolenyAdresar & cell.Value & "\" & ZakazkoveCislo & "-" & CistyTvarZakaznikAkce & ""

If Len(Dir(UmisteniSlozkyZakazkyArr, vbDirectory)) = 0 Then
'Nenalezena
Else
KontrolaExistenceSlozkyZakazky = UmisteniSlozkyZakazkyArr
'MsgBox (KontrolaExistenceSlozkyZakazky)

Exit For

End If

If cell.Value = "" Then
MsgBox ("Složka nenalezena")
End If

Next cell


Sheets("Config").Visible = False
Sheets("Temp").Visible = False
Workbooks(ZakazkovaKniha).Sheets("Kniha zakázek").Activate
Application.ScreenUpdating = True

End Function

Ochrany jsem řešil takto.

Čísla se zapisují do sloupce a není problém, že by došlo místo.

Hodnota First zažím nepřesáhla 2 ciferné číslo, naní pro to ani předpoklad.



Number = Application.InputBox(Prompt:="Zadejte číslo ", Type:=1)
If Number = "" Then Exit Sub
First = Application.InputBox("Zadejte počáteční číslo", Default:="01", Type:=1)
If First = "" Then Exit Sub
Last = Application.InputBox("Zadejte koncové číslo", Type:=1)
If Last = "" Then Exit Sub

For i = First To Last
ActiveCell.Value = Number & " " & Format(i, "00")
ActiveCell.Offset(1, 0).Select
Next i

Přesně to jsem potřeboval, moc děkuji.

Dobrý den,

chtěl bych používat níže uvedené makro pro generování číselného řetězece. Bohužel výstup je např. 1234 1 a já bych potřeboval 1234 01. Předem děkuji za každou radu.


Dim Number As String
Dim First As String
Dim Last As String

Number = InputBox("zadej číslo řady")
First = InputBox("zadej první číslo")
Last = InputBox("zadej poslední číslo")
For i = First To Last
ActiveCell.Value = Number & " " & i
ActiveCell.Offset(1, 0).Select
Next i

Problém to není. Nejlépe za užití plánovač úloh Windows.
Počítač běží stále, nebo zapínáte každý den?

Omlouvám se, pokud jsem se chybně vyjídřil.

Problém je to, že nevím jak načíst data z aktivní oblasti a říct aby červená pole překopírovala.

Dobrý den,

potřeboval bych z vybrané oblasti kopírovat 1 a 3-6 sloupec a tyto sloupce následně vložit do druhého sešitu od pole B3.

Předem děkuji za veškeré rady.


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

Ověření datumu TextBox1.Text

elninoslov • 18.10. 20:15

Auto mazanie emailov

elninoslov • 18.10. 20:01

Ověření datumu TextBox1.Text

Scraper • 18.10. 18:25

Auto mazanie emailov

Pavol1 • 18.10. 17:10

zdroj dat ve VBA

elninoslov • 18.10. 17:08

zdroj dat ve VBA

lubo • 18.10. 15:40

EXCEL VBA vyhledání buňky

lubo • 18.10. 15:39