ahoj potreboval bych aspon malu ukazku zapisu pls nejak sa nemozem pohnut vpred
:D ja som ale deges duplicity uz OK UserForm_Activate
Ahoj
Tak Ten list box som uz vyriesil. Akurat ma trapi ten export dat do tabulky. A este jeden dotaz proc my v comboBoxe duplikuje zadane hodnoty
V prilohe zip
Ahoj
Mam problemik s UserForm. Ako prve asi s listbox kde nemozem zapisovat alespon neviem preco. Potrebujem poradit po odkliknuti ok aby sa vsetky data zapsali do suboru(tabulka)v ktorej su vytvorene listy. Cielovy list urcuje comboBox7. Prosim o radu pre pripad Priloha.
Dakujem za vsetky odpovede
Ahoj
Potreboval by som poradit. V jednom subore mam data v jednom riadku priklad v 4riadku. Od A4 az P4. Na ploche mam vytvoreny dalsi subor (Total) vnom sa nachadzaju sheety s menami do ktorych chcem exportovat tieto data podla hodnoty v bune A4. Cize ak A4= Peter tak exportovat do (Total) a sheet(Peter). Export data viem ale nejek sa my nedaty priradit ten list.
Co takto ?
Ahoj vysledok ma byt v C17 ? ak jo nieje problem
Tak som to dokumal :tady pro vse co maji podobny problem a tiez zacinaju s VBA
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
'We exit the sub when your answer is NO in the security dialog that you only
'see when you copy a sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
' 'Change all cells in the worksheets to values if you want
' For Each sh In Destwb.Worksheets
' sh.Select
' With sh.UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
' Destwb.Worksheets(1).Select
' Next sh
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Ahoj Mam udelane makro na odosielanie mailu bohuzial sa my nejak nedary pridat prilohu klidne by stacil aktualnzy sheet a automaticky odoslat bez toho aby som to musem odkliknut (send):
Dik za kazdy nazor
Sub Blue_mail()
Set Outlook_Aplication = CreateObject("Outlook.Application")
Set Outlook_Aplication_MAPI = Outlook_Aplication.GetNamespace("MAPI")
Set Outlook_Aplication_ITEM = Outlook_Aplication.CreateItem(0)
Outlook_Aplication_ITEM.Importance = olImportanceHigho
Outlook_Aplication_ITEM.Display
'olMail.Display
Const olFormatHTML As Integer = 2
Const olMail As Integer = 43
Dim oOL As Object, oInsp As Object
Dim SourceTO As String
Dim SourceCC As String
Dim SourceSU As String
Dim SourceBody As String
SourceTO = Sheets("Blue").Range("A1")
SourceCC = Sheets("Blue").Range("A2")
SourceSU = Sheets("Blue").Range("A3")
SourceBody = Sheets("Blue").Range("A4")
Set oOL = CreateObject("Outlook.Application")
instance
Set oInsp = oOL.ActiveInspector
oInsp.CurrentItem.BodyFormat = olFormatHTML
Outlook_Aplication_ITEM.To = SourceTO
Outlook_Aplication_ITEM.CC = SourceCC
Outlook_Aplication_ITEM.Subject = SourceSU
Outlook_Aplication_ITEM.Body = SourceBody
'Outlook_Aplication_ITEM.Send
End Sub
Moc dil este som to trocha upravil aby to ukladalo pod nazvom s bunky npr :C6 tohle usetry moc casu v praci ukladat 30listouv.
Damlepsi dotaz ak by som chcel ulozit len lisky ktore maju v ("B3") hodnotu vedsiu ako 1 klidne ich muzebyt 30. Vzdy ulozit podla nazvu v A1 v danom liste.
AHoj Mam dotaz Mam subor s 30 listami potrebujem ulozit len ten ktory mam prave otvoreny pri tomto my to
uklada cely subor s 30lis :
Sub ulozit()
ChDir "C:\" 'cesta kam se má soubor uložit
ActiveWorkbook.SaveAs Filename:=Range("A1")
End Sub
Dakujem pekne toto je lepsia varianta povodne co si my navrhol som este predelal ale pri zadani inej hodnoty my to mazalo povodny s pola a prepisovalo do druheho a delalo bordel v dalsom sheete kde som mam tieto hodnoty s danych poli nalinkovane.
Este ras dik si borec.
Ahoj mam otazku mam macro na triedenie podla zadanej dodnoty diky JAZA.M. Potreboval bych este nejak aktualizovat data pri zmene hodnoty. Pri opetovnom zadani zmene pola vytvara duplicita. Viac prispevok FILTER .
Vzor tady :
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo x
If Target.Column = 4 Then
Dim sl As Single
Dim rd As Single
Select Case Target.Value
Case Is = 1
sl = 8
Case Is = 2
sl = 13
Case Is = 3
sl = 18
Case Is = 4
sl = 23
End Select
rd = 4
Do While Cells(rd, sl) <> ""
rd = rd + 1
Loop
Cells(rd, sl) = "'" & Cells(Target.Row, 1)
Cells(rd, sl + 1) = "'" & Cells(Target.Row, 2)
Cells(rd, sl + 2) = Cells(Target.Row, 3)
End If
x:
End Sub
este mam jeden dotaz slo by nejak este upravit ? Ked tam zadam napr :1 a pak prepisem na inu cize 2,3,4 sa pole aktualizuje a nezapise to ako duplicitu na ine pole ?
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.