PC-HELP.CZ

Zdravím..
Mám problém s tymto kódom.
Celý kód prebehne v poriadku, no ked sa prilepia hodnoty do "vystup" excel mi akoby zamrzne a ide iba vba editor.Musim zošit qir dbs.xlsm dať križikom akoby uzavrieť a potom storno...nasledne sa excel znova rozbehne..neviem si rady.. :idea:

Vedeli by ste mi niekto pomôcť?

Kód: Vybrat vše

Public Function f_Is_WkBk_Open(ByVal f_sWkBk As String) As Boolean
Dim oWkBk As Workbook
Dim bIsOpen As Boolean
bIsOpen = False

For Each oWkBk In Application.Workbooks
If InStr(f_sWkBk, oWkBk.Name) > 0 Then
bIsOpen = True
Exit For
End If
Next oWkBk
f_Is_WkBk_Open = bIsOpen
Set oWkBk = Nothing
End Function

Sub zapis_qir_dbs()
    
    Dim vystup As Worksheet
    Dim vstup As Worksheet
    Dim nextRow As Long
    Dim oCol As Long
    Dim myCopy As Range
    Dim myTest As Range
    Dim hodnoty As Range
    Dim lCount As Long
    Dim strSheetName As String
    
    Set vstup = ActiveWorkbook.ActiveSheet
    
     
'hodnoty na pomocny listn ak koniec nazvu lisu (B) nezapisovať
    strSheetName = ActiveSheet.Name
    If Right(strSheetName, 3) = "(B)" Then
GoTo koniec
End If

'hodnoty na pomocny list

Application.ScreenUpdating = False
    ActiveSheet.Range("l6").Copy
    Sheets("pomocny_list").Range("a1").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False

    ActiveSheet.Range("f10").Copy
    Sheets("pomocny_list").Range("a2").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("f9").Copy
    Sheets("pomocny_list").Range("a3").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("f8").Copy
    Sheets("pomocny_list").Range("a4").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("f7").Copy
    Sheets("pomocny_list").Range("a5").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("f6").Copy
    Sheets("pomocny_list").Range("a6").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("l7").Copy
    Sheets("pomocny_list").Range("a7").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("l8").Copy
    Sheets("pomocny_list").Range("a8").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    ActiveSheet.Range("l9").Copy
    Sheets("pomocny_list").Range("a9").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
     
     Application.CutCopyMode = False
     Application.ScreenUpdating = False
 
 
 Application.ScreenUpdating = True
    Set myCopy = Sheets("pomocny_list").Range("hodnoty")
    myCopy.Copy
    
    'cells to copy from Input sheet
    
    oCol = 2 'starting column where copied data is pasted
Dim btest As Boolean
btest = f_Is_WkBk_Open("C:\Documents and Settings\user\Dokumenty\Forma reportov_all\prepojene subory\qir dbs.xlsm")
If btest Then
GoTo dalej
Else
Workbooks.Open Filename:="C:\Documents and Settings\user\Dokumenty\Forma reportov_all\prepojene subory\qir dbs.xlsm"
End If

dalej:

Windows("qir dbs.xlsm").Activate
Set vystup = Worksheets("QIR dbs")
    With vystup
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With vstup
        If Application.CountA(myCopy) <> myCopy.Cells.Count Then
            MsgBox "Prosím vyplňte všetky údaje!"
            Cancel = True
            Exit Sub
        End If
    End With

    With vystup
        With .Cells(nextRow, "A")
            .Value = Format(Date, "DD.MM.YYYY")
            End With
        '.Cells(nextRow, "B").Value = Application.UserName
       Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True

End With
    
    oCol = oCol + myCopy.Cells.Count

    'clear input cells
    'With myCopy
     '   .Cells.ClearContents
      '  .Cells(1).Select
    'End With

koniec:
    
    End Sub

PasteSpecial (xlPasteValues)
Application

qir dbs.xlsm: (40.64 KiB) Staženo 19 x

PRIKLAD.xlsm: (342.66 KiB) Staženo 23 x

Ahoj, zkusil bych v tom qir dbs.xlsm zrušit všechna makra a události listu a sešitu a uložit s příponou xlsx. A zkus jestli to stále zlobí. Viz. přiložený soubor. Pak jsem přidal do příkladu svoje makro, jak bych řešil ukládání těch vybraných položek.
Neřešil jsem tu kontrolu na vyplnění těch potřebných položek.
Přidal jsem list CTRL, kde jsou definované cesta ke qir dbs.xlsx, název toho cílového sešitu a listu. Spustí se to přes tlačítko na tom formulářovém listu.

Co chceš, aby ta makra v tom qir dbs vůbec dělala?
Karel

ukladanie do qir dbs.xlsm vyvolavam po stlaceni ikonky tlacit v zdrojovom subore a makra v qir dbs.xlsm maju akurat za ulohu vyznacit cely riadok kde sa nachadza aktivna bunka..zajtra v praci to vyskusam.Ale aj tak mi je divne pokial som mal list qir dbs v zdrojovom zosite tak to problemy nerobilo.. :eh:

--- Doplnění předchozího příspěvku (14 Zář 2012 07:07) ---

takze zmena typu suboru na xlsx nepomohla, asi musim prerobit celu koncepciu ukladania.. :(

--- Doplnění předchozího příspěvku (14 Zář 2012 08:55) ---

A este jeden poznatok.
Pokial makro spustim z prostredia VB vsetko prebehne ako ma a nic nezamrzne.
Zamrzne to len ak ho spustim pomocou ikonky na tlacenie v excely.
Moze byť problem aj s
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Call zapis_qir_dbs
End Sub
???

Ta moje verze mi funguje. Ještě jsem vlastně odstranil událost na listu toho formuláře, kdy do buňky A1 zapisuješ 1. A i to berfore_print. Ale tím by se to snad nemělo sekat. Nebo to zkus pouštět vlastním tlačítkem,
jako to mám já.

Tak vyskúšal som vlastne tlačitko na volanie makra ako mas ty.Vsetko krasne funguje aj s mojim kodom.
Len nechapem preco to potom nejde automaticky previest aj pred tlacou...

S těmi tvými makry se to chová nějak divně (i po té, co jsem qir dbs udělal bez maker). Když chci zavřít okno s qir dbs.xlsx, tak vyskočí okno, jestli chci uložit Přiklad.xlsm.

--- Doplnění předchozího příspěvku (14 Zář 2012 11:02) ---

Po té co to makro doběhne, tak když klikám na nějakou buňku v qir dbs, označí se úplně jiná buňka.
Doufám, že to není nějaký vir.

:) mne to bezi uz ako ma..
len to musim volat tym tlacitkom..a vir to urcite nieje...neviem o tom ze by som mal take schopnosti naprogramovat vir v makrach..

PC-HELP.CZ

Pred koncom VBA kodu excel zamrzne

Pred koncom VBA kodu excel zamrzne

Re: Pred koncom VBA kodu excel zamrzne

Re: Pred koncom VBA kodu excel zamrzne

Re: Pred koncom VBA kodu excel zamrzne

Re: Pred koncom VBA kodu excel zamrzne

Re: Pred koncom VBA kodu excel zamrzne

Re: Pred koncom VBA kodu excel zamrzne