Příspěvky uživatele

"Iba jedna vec" - zdá sa Vám to stále iba "iba" ?
Je to podstatne zložitejšie.

Šmarjá, čo je to zas za požiadavku bez prílohy ? Príklad (potrebujete uchovávať staré hodnoty), kde je to volané podľa zmeny A2:A3. Dá sa to ale urobiť aj na metódu Calculate, ale takto to bude asi lepšie.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim V(), O(), x As Byte

If Not Intersect(Cells(2, 1).Resize(2), Target) Is Nothing Then
ReDim V(1 To 1, 1 To 7): ReDim O(1 To 1, 1 To 7)
V = Cells(2, 27).Resize(1, 7).Value
O = Cells(1, 27).Resize(1, 7).Value
Application.ScreenUpdating = False

For x = 1 To 7
If V(1, x) <> O(1, x) Then Call SizeCircle(Shapes("Ovál " & 41 + x), V(1, x))
Next x

Application.EnableEvents = False
Cells(1, 27).Resize(, 7).Value = V
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Sub SizeCircle(ByRef xCircle As Shape, Diameter)
Dim PozW As Single, PozH As Single, PolD As Single

Diameter = IIf(Diameter > 100, 10, IIf(Diameter < 1, 1, Diameter))
With xCircle
PozW = .Left + .Width / 2
PozH = .Top + .Height / 2
PolD = Diameter / 2
.Width = Diameter
.Height = Diameter
.Left = PozW - PolD
.Top = PozH - PolD
End With
End Sub

Pridajte tam
DoEvents
pred
Loop
ale pozor, prírastok dajte aspoň 10. Určite nie po 1, to budú skôr Vianoce kým to prejde po 1.

Pravé tlačítko a vlastné PopUp Menu ?

Skúste jednu z týchto 2 metód

Jednoduchá tabuľka. Teda ak som to pochopil správne...

To je predsa logické, že Vám tam dá znovu oddeľovače. Veď predsa použijete stále rovnaký polyfunkčný exportovací systém.

Použite tú druhú metódu, čo som postol, potom čo urobíte požadované úpravy v dátach (možno aj tie by sa dali zautomatizovať makrom). Žiaľ nevieme aké typy dát sú v stĺpcoch, koľko ich je, a aký požadovaný formát majú mať napr. dátumy či desatinné čísla. Toto si ošetríte pre požadované polia v tom cykle x napr cez Select Case x.

Dostanete z toho požadované CSV UTF-8 BOM, bez nadbytočných oddeľovačov s prvom riadku.

Toho BOM sa ľahúčko zbavíte v NotePad++ asi za 4 sekundy (menu Kódovanie - Kódovať v UTF-8 bez BOM - Uložiť).

Ak to robíte často, makro si môžete dať ako doplnok do lišty v Exceli, len teda otvoríte CSV, urobíte úpravy (alebo ak budú automatizovateľné makrom, tak ručne nemusíte), stlačíte čudlík a vytvorí sa nový CSV, ktorý sa môže už rovno v NotePad++ otvoriť a len čaká na Vaše 3 kliky.

Kým sa nepríde na lepší systém priamo v Exceli, myslím, že by to bolo prijateľné.

Neviem, či je možné rovno v Exporte Excelu urobiť rozdielny počet stĺpcov, no tu sú dva príklady:
Sub ExportCSV()
Dim F As Object, Prvy As Integer, Ostatne As Integer, Riadkov As Long, i As Long, x As Integer, rngUsed As Range, D(), S As String
Const DEL = ";"

With ActiveSheet
Prvy = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rngUsed = .UsedRange
Ostatne = Intersect(rngUsed, rngUsed.Offset(1, 0)).Columns.Count
With rngUsed
Riadkov = .Rows.Count
ReDim D(1 To Riadkov, 1 To .Columns.Count)
D = .Value
End With
End With

Set F = CreateObject("Scripting.FileSystemObject").CreateTextFile("D:\CSVExport.csv", True, True)
For i = 1 To Riadkov
S = vbNullString
For x = 1 To IIf(i = 1, Prvy, Ostatne)
S = S & IIf(S = vbNullString, vbNullString, DEL) & D(i, x)
Next x
F.Writeline S
Next i

Set F = Nothing: Set rngUsed = Nothing
End Sub

Sub ExportCSV2()
Dim Prvy As Integer, Ostatne As Integer, Riadkov As Long, i As Long, x As Integer, rngUsed As Range, D(), S As String, Pole() As String
Const DEL = ";"

With ActiveSheet
Prvy = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rngUsed = .UsedRange
Ostatne = Intersect(rngUsed, rngUsed.Offset(1, 0)).Columns.Count
With rngUsed
Riadkov = .Rows.Count
ReDim D(1 To Riadkov, 1 To .Columns.Count)
D = .Value
End With
End With

ReDim Pole(Riadkov - 1)
For i = 1 To Riadkov
S = vbNullString
For x = 1 To IIf(i = 1, Prvy, Ostatne)
S = S & IIf(S = vbNullString, vbNullString, DEL) & D(i, x)
Next x
Pole(i - 1) = S
Next i

With CreateObject("ADODB.Stream")
.Open
.Charset = "UTF-8"
.WriteText Join(Pole, vbCrLf)
.SaveToFile "D:\CSVExport.csv", 2
.Close
End With

Set rngUsed = Nothing
End Sub

Má to ale jedno podstatné ALE. Už X-krát omieľané kódovanie UTF-8 v CSV a BOM. Prvý kód neurobí UTF-8 ale nejaké "UCS-2 LE BOM". Druhý kód urobí "UTF-8 BOM". To BOM sú 3 bajty v súbore, ktoré robia šarapatu pri importoch do rôznych systémov. Vyskúšajte, alebo sa inšpirujte pri hľadaní iného riešenia.

Možno klasickým exportom urobiť CSV, to v makre otvoriť ako text, zmazať v prvom riadku všetky ";" sprava po najbližší znak a súbor znovu uložiť. Ale zase to ALE, lebo ak by sa Vám aj podaril Export do UTF-8 bez BOM, tak takéto uloženie to opäť degraduje.

Možno má niekto niečo použiteľnejšie.

Všetkým bunkám nastavte vo Formátovať bunky - Ochrana - Zamknúť bunky. Na tom istom mieste zrušte zaškrtávatko pre bunky určené na zmenu. Pre tieto bunky potom ešte nastavte podmienené formátovanie. V menu Revízia - Zabezpečiť hárok - nastavte heslo a položky (môžete ich asi nechať bez zmeny). Uložte.
Excel ale nieje trezor, a hlavne staré XLS sa dá ľahko prelomiť. Najnovší XLSX v nových Office už také ľahké prelomenie nedovoľuje.

Príkladov je mnoho...

Private Sub CommandButton1_Click()
Dim Pole() As String
If Len(TextBox1.Text) > 0 Then
Pole = Split(TextBox1.Text, vbCrLf)
ActiveSheet.Cells(1, 1).Resize(UBound(Pole) + 1, 1).Value = WorksheetFunction.Transpose(Pole)
End If
End Sub

No a toto ste skúšal ?
Súbor - Uložiť ako - Uložiť vo formáte "Webová stránka (*.htm;*.html). Zvoliť "Celý zošiť" alebo "Výber: Hárok". Ak ide iba o oblasť, tak v nasledujúcom okne vybrať v položke Zvoliť Rozsah buniek - šípkové tlačítko - vybrať súvislú oblasť. Publikovať.

Občas si treba po sebe aj prečítať, či to dáva zmysel. Chcel ste získať mená zákazníkov na základe zadaných parametrov. V ďalšom príspevku chcete zadávať meno zákazníka. Tieto 2 veci si predsa navzájom odporujú.
Každopádne SmartFilter na Tabuľku, KT, alebo KT+SmartFilter.

Tak skúste KT, alebo ešte jednoduchšie rýchle filtre na Tabuľku. Tá Vaša "tabuľka" musí byť prevedená na objekt "Tabuľka".

Myslel som, že nejako nadväzujete na to nedávne vlákno, kde sa malo validovať cez danú stránku.

Váš kód prejde aj v desktopovom E2016. Vytvorené CSV je podľa NotePad++ UTF-8-BOM. Ak dám v NotePad++ uložiť tento súbor bez BOM, je o 3 bajty menší.
Každopádne a) aj b) je správne.

Tá stránka bude nejaká precitlivelá, nič sa jej nepáči, lebo aj na súbor z NotePdau++ píše to isté.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje