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
poradí mi někdo co stím?
Opravte si to. Máte to rozbitý.citovat
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: chyba - error 1004
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.
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
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
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
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
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
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
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
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
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
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
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
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