Chýba Vám predsa makro v module ThisWorkbook:
Option Explicit
Private Sub Workbook_Open()
CreateMyTag
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
CreateMyTag
Call RefreshRibbon(Tag:=MyTag)
End Sub
A keď tam vyberiete prihlásenie cez MS účet, alebo Win ?
Nemôžem prísť na to, ako znovu vyvolám to okno s voľbou prihlásenia, ak už som sa ho raz zbavil...
Ak zadáte do prázdneho dotazu toto, načíta Vám zoznam súborov (alebo čokoľvek) ?
Zdroj = SharePoint.Files("https://lannuttigroup-my.sharepoint.com/personal/radek_braum_lannutti_com/Documents/pokus/relativni cesta/kj", [ApiVersion = 15])
Môžete sa s tým hrajkať
OK. Napíšte mi teraz presne, ktoré tlačítka majú byť aktívne na ktorom liste.
Očakávam takéto nejaké inštrukcie:
List ____ Tlačítka
..................
Plán ____ "Plán", "Tisk do PDF"
Data ____ "data", "Tisk do PDF"
Doklad __ "data", "data+doklad", "Tisk do PDF", "složka PDF"
Inak som tú origo prílohu zjednodušil do pochopiteľnejšej podoby (snáď). Tak by som obdobne urobil aj Vašu.
Dokážete si odtiaľto vybrať čo potrebujete?
Použil som rovnaký objekt ako Vy. Aký iný obdĺžnik má ešte E2003?
Či to ide presne takto aj na iné objekty sa paušálne asi povedať nedá. Uveďte príklad, o aký objekt máte záujem a pozriem v štruktúre vlastností daného objektu.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shape As Object
If Not Intersect(Range("A1"), Target) Is Nothing Then
On Error Resume Next
Set shape = Shapes("Popisek_1")
If Err.Number <> 0 Then
Set shape = Shapes.AddShape(msoShapeRectangle, 50, 50, 200, 50)
shape.Name = "Popisek_1"
End If
On Error GoTo 0
shape.OLEFormat.Object.Text = Range("A1")
shape.Visible = True
Set shape = Nothing
Else
On Error Resume Next
Shapes("Popisek_1").Visible = False
On Error GoTo 0
End If
End Sub
Ale neodpovedáte na jedinú otázku.
Ak je požadovaná tlačiareň predvolená, netreba vôbec čachre s ActivePrinter.
Heh :)
Ale to nie je úprava k funkčnosti, ale úprava na preskočenie chyby. Chybu to nijako nenapraví, chyba ostáva, žiadna tlačiareň sa nezmení, ostáva pôvodná. A funguje Vám to len preto, lebo pôvodná bola tá, ktorú chcete.
Akú hodnotu má tmp po kroku?
tmp = .ActivePrinter
Aký je názov tej tlačiarne na mieste, ktoré som Vám písal?
Po otvorení úplne prvého súboru v kroku
.Documents.Open Soubor
pozrite do otvoreného Wordu, a tam kde sa mení tlačiareň, aká je tam nastavená?
Máte v systéme tlačiareň, ktorá sa volá "Duplex" ? Otvorte si Word, Súbor - Tlačiť - Tlačiareň - rozkliknite a presne (!) opíšte požadovaný názov.
Pred spaním rýchlo. Nemám ako vyskúšať.
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
Sharepoint (SP) nemám ako vyskúšať.
Berme do úvahy spomínaný nefunkčný variant s SP:
Ak otvoríte súbor "matricePQ-nacitani.xlsm", čo je v parametroch "Soubor" a "Cesta"?
Ak dáte vytvoriť pokusný nový dotaz:
Záložka Údaje - Získať údaje - Zo súboru - Z priečinka služby SharePoint
a zadáte Vašu SP adresu
https://lannuttigroup-my.sharepoint.com/personal/radek_braum_lannutti_com/Documents/pokus/kj
dostanete nejaký zoznam súborov?
Problém s lomítkami samozrejme bude, lebo lokálne úložisko je "\" a internet "/".
Každopádne, ak tento pokus zobrazí nejakú adresárovú štruktúru na SP, tak je dosť pravdepodobné, že po úprave kódu (lomítka) bude pracovať ako s normálnymi súbormi. Ja budem stále iba tipovať (SP nemám), ale posunie nás to ďalej.
Zaujímavosť:
Vedeli ste, že v novom Exceli 365 je možnosť nájsť zaplnenú oblasť takto ?
parametre určujú či orezať stĺpec/riadok a na konci/začiatku
=TRIMRANGE(Nastavení!$B$2:$B$16;2)
=ROZSAH_STŘIHU(Nastavení!$B$2:$B$16;2)
alebo
bodka určuje rez na začiatku ".:" alebo na konci ":."
=Nastavení!$B$2:.$B$16
Po starom napr.
=OFFSET(Nastavení!$B$2;;;COUNT(Nastavení!$B$2:$B$16))
=POSUN(Nastavení!$B$2;;;POČET(Nastavení!$B$2:$B$16))
Celkom dosť zaujímavé...
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.