Příloha 1
Příloha: 
56986_year.xlsx (12kB, staženo 2x)
citovat56986_year.xlsx (12kB, staženo 2x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Přenos dat mezi soubory
MS Excel
Téma: Přenos dat mezi soubory 
Zaslal/a Petr-M 14.11.2024 12:10
Dobrý den. Přicházím s prosíkem o radu na přenos dat mezi soubory. V jednom jsou údaje pořád ve stejné buňce a ve druhém to potřebuju vložit do kalendáře a zachovat. Takže po následném otevření souboru v dalších dnech tam ty původní údaje musejí zůstat a doplnit nové. Podrobnosti v přílohách. Krkolomné vysvětlování, ale snad to je alespoň trochu srozumitelné. Děkuji moc.
Příloha 2
Příloha: 56987_summary.xlsx (11kB, staženo 2x)
citovat56987_summary.xlsx (11kB, staženo 2x)Jedine makrom. Viete, kde bude ten súbor summary.xlsx umiestnený? Bude to vždy rovnaká zložka ako ten otváraný súbor year.xlsx?
Makro do modulu ThisWorkbook/Tento_zošit
Private Sub Workbook_Open()
Dim Cesta As String, Soubor As String, List As String
Dim Sloupec
Dim bNeprepisovat As Boolean
Cesta = ThisWorkbook.Path & "\"
Soubor = "summary.xlsx"
List = "Summary"
With Worksheets("Year")
Sloupec = Application.Match(CDbl(Date), .Rows(1).Value2, 0)
If IsError(Sloupec) Then
MsgBox "Dnešní datum " & Format(Date, "d.m.yyyy") & " se v souboru nevyskytuje.", vbCritical
Exit Sub
End If
Cesta = "'" & Cesta & "[" & Soubor & "]" & List & "'!C4"
With .Cells(2, Sloupec).Resize(4)
If WorksheetFunction.CountBlank(.Resize(4)) <> 4 Then
.Activate
bNeprepisovat = MsgBox("V oblasti datumu " & Format(Date, "d.m.yyyy") & " se již nacházejí data." & vbNewLine & _
"Chcete je přepsat ?", vbYesNo + vbExclamation) = vbNo
End If
If bNeprepisovat Then
MsgBox "Nic nebylo zapsáno.", vbInformation
Else
.Formula = "=IF(" & Cesta & "="""",""""," & Cesta & ")"
.Value = .Value
End If
End With
End With
End Sub
Makro do modulu ThisWorkbook/Tento_zošit
Private Sub Workbook_Open()
Dim Cesta As String, Soubor As String, List As String
Dim Sloupec
Dim bNeprepisovat As Boolean
Cesta = ThisWorkbook.Path & "\"
Soubor = "summary.xlsx"
List = "Summary"
With Worksheets("Year")
Sloupec = Application.Match(CDbl(Date), .Rows(1).Value2, 0)
If IsError(Sloupec) Then
MsgBox "Dnešní datum " & Format(Date, "d.m.yyyy") & " se v souboru nevyskytuje.", vbCritical
Exit Sub
End If
Cesta = "'" & Cesta & "[" & Soubor & "]" & List & "'!C4"
With .Cells(2, Sloupec).Resize(4)
If WorksheetFunction.CountBlank(.Resize(4)) <> 4 Then
.Activate
bNeprepisovat = MsgBox("V oblasti datumu " & Format(Date, "d.m.yyyy") & " se již nacházejí data." & vbNewLine & _
"Chcete je přepsat ?", vbYesNo + vbExclamation) = vbNo
End If
If bNeprepisovat Then
MsgBox "Nic nebylo zapsáno.", vbInformation
Else
.Formula = "=IF(" & Cesta & "="""",""""," & Cesta & ")"
.Value = .Value
End If
End With
End With
End Sub
Příloha: 
56989_year.zip (18kB, staženo 1x)
citovat56989_year.zip (18kB, staženo 1x)Toho jsem se bál... Ano, bude pořád na stejném místě. Děkuji, vyzkouším to. Děkujicitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články