Вылет программы при использовании макроса - Microsoft Office Excel - Страница 9

SaLoKiN · 31.10.2013, 12:32

Ну коль уж такая пляска....нашел на сайте excelvba.ru очень хорошую штуку,добавление в контекстное меню ячейки два новых действия
решил подпилить под свои потребности,но вот недопойму чего не так...
хотелось чтобы при выборе пункта вставлялась новая строка,которая будет копировать половину значений со строки ниже,а половину вставлять из программы.

Код:

Sub PasteValues()
On Error Resume Next
     With Worksheets("Лист1")
        .Rows(Selection.Row).Insert
    '    .Cells(Selection.Row, 1) = .Cells(y + 1, 1)
    '    .Cells(Selection.Row, 2) = .Cells(y + 1, 2)
    '    .Cells(Selection.Row, 5) = .Cells(y + 1, 5)
    '    .Cells(Selection.Row, 3) = "м"
    '    Application.CutCopyMode = False
    End With
    Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub

При попытке обращения к ячейкам получаю в лоб!

Простите,туплю.
с y напутал))) заменил но не везде на Selection.Row

Hugo121 · 31.10.2013, 12:55

Ну вот, научили хорошему

Нафига там эти активейты с селектами??!!

Развеж так не работало?

Код:

    With Sheets("для l5")
        .Range(.Cells(3, 1), .Cells(j + 1, 9)).Copy
    End With

Если не работало - нет такого листа, или j<0 (или больше числа строк на листе-1)

P.S. Это я отвечал на http://programmersforum.ru/showpost....8&postcount=80

SaLoKiN · 01.11.2013, 05:12

Спасибо Hugo121! оказывается во всем виноват select. который то и не нужен совсем)

SaLoKiN · 01.11.2013, 05:42

Раскурил я добавление в контекстное меню своих пунктов. Про которое писал чуть выше...но блин, у меня таких пунктов ажн 10 штук!
Возможно ли собрать это в группу как скажем сделано в пункте "фильтр" ?

UPD
не придумал, но сделал костыль =)

Код:

Sub PasteValues()

On Error Resume Next

     With Worksheets("Лист1")
       .Rows(Selection.Row).Insert
       .Cells(Selection.Row, 1) = .Cells(Selection.Row + 1, 1)
       .Cells(Selection.Row, 2) = .Cells(Selection.Row + 1, 2)
       .Cells(Selection.Row, 3) = .Cells(Selection.Row + 1, 3)
                   
Select Case InputBox("Введите тип работ:" + vbCrLf + "р-ремонт" + vbCrLf + "м-мойка" + vbCrLf + "г-АГЗС" + vbTab + "з-АЗС" + vbCrLf + "п-перемещение" + vbCrLf + "с-СТО" + vbTab + "т-ТО")
Case "р": .Cells(Selection.Row, 7) = "ремонт"
.Cells(Selection.Row, 4) = "р"
.Cells(Selection.Row, 14) = "Петухова"
Case "м": .Cells(Selection.Row, 7) = "мойка"
.Cells(Selection.Row, 4) = "м"
.Cells(Selection.Row, 14) = "Петухова"
Case "г": .Cells(Selection.Row, 7) = "АГЗС"
.Cells(Selection.Row, 4) = "г"
.Cells(Selection.Row, 14) = "Тролл"
Case "з": .Cells(Selection.Row, 7) = "АЗС"
.Cells(Selection.Row, 4) = "з"
.Cells(Selection.Row, 14) = "Тула"
Case "с": .Cells(Selection.Row, 7) = "СТО"
.Cells(Selection.Row, 4) = "с"
Case "т": .Cells(Selection.Row, 7) = "ТО"
.Cells(Selection.Row, 4) = "т"
Case "п": .Cells(Selection.Row, 7) = "перемещение"
.Cells(Selection.Row, 4) = "п"

End Select
        .Cells(Selection.Row, 8) = .Cells(Selection.Row + 1, 8)
       .Cells(Selection.Row, 9) = .Cells(Selection.Row + 1, 9)
       .Cells(Selection.Row, 10) = .Cells(Selection.Row + 1, 10)

       .Cells(Selection.Row, 30) = "=(RC[-2]*60+RC[-1]-RC[-10]*60-RC[-9])/60"
        Application.CutCopyMode = False
      
'
.Cells(Selection.Row, 20).Select
  


    End With
    'Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub

Хочется на кнопачках через форму такую штуку, да времени нет =( как будет попытаюсь. Если есть идеи по этому поводу, всегда рад наставлениям от вас ;-)
UPD
нашел про группировку в меню

SaLoKiN · 01.11.2013, 08:09

UPD
тихо сам с собою, я веду беседу...
вообщем вот какая красота

Код:

Option Explicit
Option Private Module
Sub MyComBars()

    Application.CommandBars("cell").Reset    'возвращаем стандартный ComBars
    With Application.CommandBars("cell").Controls.Add(Type:=msoControlPopup, Before:=1)
        '.OnAction = "PasteValues"    ' назначаем кнопке макрос
        .Caption = "Вставить хоз. работы"
        '***************ремонт**************
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteR"
            .FaceId = 133
            .Caption = "Ремонт"
        End With
        '***************мойка**************
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteM"
            .FaceId = 133
            .Caption = "Мойка"
        End With
        '***************перемещение**************
         With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteP"
            .FaceId = 133
            .Caption = "Перемещение"
        End With
        '***************АГЗС**************
         With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteG"
            .FaceId = 133
            .Caption = "АГЗС"
        End With
        '***************АЗС**************
         With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteA"
            .FaceId = 133
            .Caption = "АЗС"
        End With
        '***************СТО**************
         With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteS"
            .FaceId = 133
            .Caption = "СТО"
        End With
        '***************ТО**************
         With .Controls.Add(Type:=msoControlButton)
            .OnAction = "PasteT"
            .FaceId = 133
            .Caption = "ТО"
        End With
    End With
 With Application.CommandBars("cell").Controls.Add(Type:=1, Before:=2)
        .OnAction = "PasteRow"    ' назначаем кнопке макрос
        .Caption = "Вставить новую строку"
End With

End Sub
'******************************** РЕМОНТ ******************************
Sub PasteR()
On Error Resume Next
With Worksheets("Лист1")
    .Rows(Selection.Row).Insert
    .Cells(Selection.Row, 1) = 1
    .Cells(Selection.Row, 2) = .Cells(Selection.Row + 1, 2)
    .Cells(Selection.Row, 3) = .Cells(Selection.Row + 1, 3)
    .Cells(Selection.Row, 4) = "р"
    .Cells(Selection.Row, 7) = "ремонт"
    .Cells(Selection.Row, 14) = "Петухова"
    .Cells(Selection.Row, 8) = .Cells(Selection.Row + 1, 8)
    .Cells(Selection.Row, 9) = .Cells(Selection.Row + 1, 9)
    .Cells(Selection.Row, 10) = .Cells(Selection.Row + 1, 10)
    .Cells(Selection.Row, 30) = "=(RC[-2]*60+RC[-1]-RC[-10]*60-RC[-9])/60"
    .Cells(Selection.Row, 20) = "=RC[+4]"
    .Cells(Selection.Row, 21) = "=RC[+4]"
    .Cells(Selection.Row, 24).Select
    Application.CutCopyMode = False
   End With
'Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub
'******************************** АГЗС ******************************
Sub PasteG()
On Error Resume Next
With Worksheets("Лист1")
    .Rows(Selection.Row).Insert
    .Cells(Selection.Row, 1) = 1
    .Cells(Selection.Row, 2) = .Cells(Selection.Row + 1, 2)
    .Cells(Selection.Row, 3) = .Cells(Selection.Row + 1, 3)
    .Cells(Selection.Row, 4) = "г"
    .Cells(Selection.Row, 7) = "АГЗС"
    .Cells(Selection.Row, 14) = "Тролл"
    .Cells(Selection.Row, 8) = .Cells(Selection.Row + 1, 8)
    .Cells(Selection.Row, 9) = .Cells(Selection.Row + 1, 9)
    .Cells(Selection.Row, 10) = .Cells(Selection.Row + 1, 10)
    .Cells(Selection.Row, 30) = "=(RC[-2]*60+RC[-1]-RC[-10]*60-RC[-9])/60"
    .Cells(Selection.Row, 20) = "=RC[+4]"
    .Cells(Selection.Row, 21) = "=RC[+4]"
    .Cells(Selection.Row, 24).Select
    Application.CutCopyMode = False
   End With
'Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub
'-------------------------------------------------------------
Sub PasteRow()
    On Error Resume Next
    With Worksheets("Лист1")
     .Rows(Selection.Row).Insert
    .Rows(Selection.Row + 1).Copy Rows(Selection.Row)
    End With
    End Sub

а возможно ли скопировать строку при скрытых столбцах?

DiemonStar · 01.11.2013, 08:22

А так?

Код:

.Rows(Selection.Row).Copy .Rows(Selection.Row - 1)

SaLoKiN · 01.11.2013, 08:36

DiemonStar
я там напутал и уже исправил,а то у мя заменялись значения..
вот так там будет

Код:

.Rows(Selection.Row).Insert
    .Rows(Selection.Row + 1).Copy Rows(Selection.Row)

вот только если отключить On Error Resume Next и скрыть столбец. он ругается на несвязные диаппазоны

DiemonStar · 01.11.2013, 08:50

Цитата:

вот только если отключить On Error Resume Next и скрыть столбец. он ругается на несвязные диапазоны

Странно, у меня не ругается...

SaLoKiN · 01.11.2013, 09:12

хм....а у вас какой офис?

SaLoKiN · 22.11.2013, 11:24

Всем привет!
Название темы снова актуально в моей очередной ситуации...
написал уйму функций для расчетов в VBA. Все считает, но ексель снова стал падать. причем не понятно отчего. т.к. рушится на ровном месте, когда ничего уже не считает.
Из-за чего может быть такая штука?

Все считается в памяти, обращение к листу сведено к минимуму(только загрузка и выгрузка)
Выход за массивы не возможен(VBA ругает)
Переменные не все описаны, возможно ли из-за этого?

31.10.2013, 12:55	#82
Hugo121 Старожил Регистрация: 11.05.2010 Сообщений: 5,166	Ну вот, научили хорошему Нафига там эти активейты с селектами??!! Развеж так не работало? Код: `With Sheets("для l5") .Range(.Cells(3, 1), .Cells(j + 1, 9)).Copy End With` Если не работало - нет такого листа, или j<0 (или больше числа строк на листе-1) P.S. Это я отвечал на http://programmersforum.ru/showpost....8&postcount=80 webmoney: E265281470651 Z422237915069 R418926282008

01.11.2013, 05:12	#83
SaLoKiN Форумчанин Регистрация: 19.09.2013 Сообщений: 597	Спасибо Hugo121! оказывается во всем виноват select. который то и не нужен совсем) Сделал сам, помоги другому! Что-то работает не так? Дебаггер в помощь!!!

01.11.2013, 08:22	#86
DiemonStar Старожил Регистрация: 08.02.2012 Сообщений: 2,173	А так? Код: `.Rows(Selection.Row).Copy .Rows(Selection.Row - 1)` Правильно поставленная задача - три четверти решения.

01.11.2013, 08:36	#87
SaLoKiN Форумчанин Регистрация: 19.09.2013 Сообщений: 597	DiemonStar я там напутал и уже исправил,а то у мя заменялись значения.. вот так там будет Код: `.Rows(Selection.Row).Insert .Rows(Selection.Row + 1).Copy Rows(Selection.Row)` вот только если отключить On Error Resume Next и скрыть столбец. он ругается на несвязные диаппазоны Сделал сам, помоги другому! Что-то работает не так? Дебаггер в помощь!!!

01.11.2013, 09:12	#89
SaLoKiN Форумчанин Регистрация: 19.09.2013 Сообщений: 597	хм....а у вас какой офис? Сделал сам, помоги другому! Что-то работает не так? Дебаггер в помощь!!!

22.11.2013, 11:24	#90
SaLoKiN Форумчанин Регистрация: 19.09.2013 Сообщений: 597	Всем привет! Название темы снова актуально в моей очередной ситуации... написал уйму функций для расчетов в VBA. Все считает, но ексель снова стал падать. причем не понятно отчего. т.к. рушится на ровном месте, когда ничего уже не считает. Из-за чего может быть такая штука? Все считается в памяти, обращение к листу сведено к минимуму(только загрузка и выгрузка) Выход за массивы не возможен(VBA ругает) Переменные не все описаны, возможно ли из-за этого? Сделал сам, помоги другому! Что-то работает не так? Дебаггер в помощь!!! Последний раз редактировалось SaLoKiN; 22.11.2013 в 11:47.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
[Qt] Вылет при изменении параметров QTableWidgetItem	WarAngel-alk	Qt и кроссплатформенное программирование С/С++	4	31.01.2013 17:58
вылет программы при выводе простого числа (cout)	Ciberal	Общие вопросы C/C++	7	27.09.2011 01:51
Вылет программы после завершение	kloffelin	Общие вопросы C/C++	3	17.04.2010 20:18
Ошибка при использовании copyfile	The Best	Общие вопросы Delphi	20	22.07.2009 13:26
Проблемка при использовании регрессии	500_pinguins	Microsoft Office Excel	0	16.06.2009 08:17