• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: chyba - error 1004

Zaslal/a vary 22.1.2016 7:05

zdravím,
program mi háže chybu: Nelze získat vlastnost OLEObject třídy worksheets a nevím co stím:

kod kopíruje obrázky z tabulky, přejmenovává je a určuje jim pozici:
For i = 4 To 44
If Sheets("Sekce").Cells(i, 24).Value <> "" Then
nazevImg = Sheets("sekce").Cells(i, 25).Value
Sheets("Sekce").OLEObjects(nazevImg).Copy
Sheets("Skladba jednotky").Paste
Sheets("Skladba jednotky").OLEObjects("image1").Name = Sheets("Sekce").Cells(i, 28).Value
nazevObr = Sheets("Sekce").Cells(i, 28).Value
Sheets("Skladba jednotky").OLEObjects(nazevObr).Top = Sheets("sekce").Cells(i, 26).Value
Sheets("Skladba jednotky").OLEObjects(nazevObr).Left = Sheets("sekce").Cells(i, 27).Value
End If
Next i

v tabulce chyba není.
poradí mi někdo co stím?
Díky.

Zaslat odpověď >

---

Strana:  1 2   další »

eLCHa(22.1.2016 7:49)#029457

Předpokládám, že jste zase založil vlákno a s další reakci už se obtěžovat nebudete.

poradí mi někdo co stím?
Opravte si to. Máte to rozbitý.citovat

vary(22.1.2016 8:01)#029458

omlouvám se, že sem nereagoval na vaše odpovědi v přechozím tématu ale sem začátečník a moc jsem vaším kodům nerozuměl a co jsem vyzkoušel mi nešlo a psát Vám že mi to nejde když vám to jde bylo zbytečný.

k tomuhle tématu:
nejde mi do hlavy proč tenhle kod, který pracuje z tabulkou a ta je správně někdy chybu nehodí a někdy jo jsem z toho blázen a ještě jednou se omlouvám za nereakce na předchozím tématu.

díky.citovat

Hav-Ran(23.1.2016 2:53)#029489

Sekce ≠ sekcecitovat

vary(23.1.2016 11:35)#029492

Boze ja sem blbec dekujicitovat

elninoslov(23.1.2016 23:01)#029504

Alebo to ešte aj trochu zrýchlite a ošetrite:
Sub Obrazky()
Dim Data()
Data = Sheets("Sekce").Cells(4, 24).Resize(41, 5).Value
Application.ScreenUpdating = False
On Error GoTo POKRACUJ
With Sheets("Skladba jednotky")
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
Sheets("Sekce").OLEObjects(Data(i - 3, 2)).Copy
.Paste
With .OLEObjects("image1")
.Top = Data(i - 3, 3)
.Left = Data(i - 3, 4)
.Name = Data(i - 3, 5)
End With
End If
Next i
POKRACUJ:
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Je to napísané len tak z brucha, nemám na čom vyskúšať, a vymýšľať sa mi nechce :)citovat

vary(24.1.2016 11:09)#029514

tak tenhle kod je super!!! velké diky za něj :-), ale ještě tam mám problém stím, že někdy se kopírovaný objekt jmenuje image2 a pak se vlastně nepřejmenuje ani nenapozicuje.citovat

elninoslov(24.1.2016 15:24)#029517

Sub Obrazky()
Dim Data()
Data = Sheets("Sekce").Cells(4, 24).Resize(41, 5).Value
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Skladba jednotky")
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
Sheets("Sekce").OLEObjects.Item(Data(i - 3, 2)).Copy
.Paste
With .OLEObjects(.OLEObjects.Count)
.Top = Data(i - 3, 3)
.Left = Data(i - 3, 4)
.Name = Data(i - 3, 5)
End With
End If
Next i
End With
If Err Then MsgBox ("Počas operácie nastala chyba.")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Koľko sa Vám ich naraz väčšinou kopíruje? Rozmýšľam, či by sa to nedalo hromadne kopírovať, či by sa neušetril nejaký čas ...citovat

vary(24.1.2016 15:30)#029518

v každém kole cyklu to zkopíruje jen jeden objekt, který to dle dat z tabulky přejmenuje a napozicuje. teď už to funguje přesě tak jak potřebuji DÍKY!!!!!citovat

vary(24.1.2016 15:41)#029519

jinak princip kódu je, že vložím 1. obrázek ze skrytého listu pak kliknu na ten první obrázek a vyberu jestli přidat obrázek před, za, pod a nebo nad. principem už to funguje jak má. Samozřejmě čas k dobru by se taky hodil ale velké díky!!!citovat

elninoslov(24.1.2016 17:24)#029522

Toto Vám urobí hromadné kopírovanie viac obrázkov naraz. Nastavenie pozície sa už potom musí logicky robiť samostatne. Či je to rýchlejšie alebo nie, neviem, rýchlosť som netestoval ...
Sub Obrazky3()
Dim Img() As String, Data(), Vyber() As Integer, i As Integer, a As Integer, r As Integer, Pocet As Integer
With Sheets("Sekce")
Data = .Cells(4, 24).Resize(41, 5).Value
Pocet = WorksheetFunction.CountIf(.Range("X4:X44"), "<>" & "")
End With
ReDim Img(1 To Pocet): ReDim Vyber(1 To Pocet)
Application.ScreenUpdating = False
On Error Resume Next
For i = 4 To 44
If Not IsEmpty(Data(i - 3, 1)) Then
a = a + 1: Img(a) = Data(i - 3, 2): Vyber(a) = i - 3
End If
Next i
Sheets("Sekce").OLEObjects.Item(Img).Copy
With Sheets("Skladba jednotky")
.Paste
a = .OLEObjects.Count
For i = a - Pocet + 1 To a
r = i - (a - Pocet)
With .OLEObjects(i)
.Top = Data(Vyber(r), 3)
.Left = Data(Vyber(r), 4)
.Name = Data(Vyber(r), 5)
End With
Next i
End With
If Err Then MsgBox ("Počas operácie nastala chyba.")
On Error GoTo 0
Application.ScreenUpdating = True
End Subcitovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse