Скопировать свой код

[Pavlo]

Здравствуйте !!! Хочу чтобы Вы помогли решить задачу по автоматизации определенного процесса. алгоритм самой задачи я уже сделал, но нужно чтобы этот код, копировал себя в шаблон и кнопка которая будет запускать выполнение этой задачи тоже записывалась в шаблон и при следующем открытии Excel любого документа у меня появлялась эта кнопка и соответственно возможность запустить мою программу. Спасибо!!!

[Pavlo]

Я наверное не так описал проблематику, перефразирую: у меня задача автоматизировать процесс для кассиров, они работают в некоторой программе (не важно в какой) которая формирует отчет (верхняя табличка) и они на основе этого отчета должны заполнить кассовую книгу, вторая табличка сверху это пример как должна заполняться книга РРО, я написал алгоритм предусматривающий (--- Д --- А ---- В --...) это налоговые ставки которые изменяются в зависимости от продаваемых товаров, так вот мне нужно чтобы была возможность вызвать мою программу с любого документа, я порылся и нашел что это можно делать с помощью личных настроек, но как ее сделать самому так и не удалось. Здесь статья http://www.excel-vba.ru/chto-umeet-exce ... temenu2007 в которой рассказывается об этом, я скопировал код, но процедура Private Sub Workbook_Open () не срабатывает и соответственно код не выполняется, я уверен что я на правильном пути, но нужна помощь. Спасибо

[Pavlo]

Я сделал. Больше не нуждаюсь в помощи. Спасибо

[ger_kar]

Посмотрел код, и хочу дать несколько рекомендаций.

Код: Выделить всё

Range("B25:K28").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

Сразу видно что код сгенерирован автоматически, это нормально, но его после этого нужно подправить. Дело в том, что основная единица, с которой в основном и происходит большинство действий - это диапазон ячеек, который представлен объектом Range. Диапазоном может быть одна ячейка, или множество, включая и весь диапазон всего листа. Поэтому нужно использовать его напрямую. Фактически такой код когда диапазон сначала выделяется Range("B25:K28").Select, а потом используется With Selection... все равно использует тот же самый объект Range, но с промежуточным действием выделения, которое сильно снижает быстродействие и вызывает эффекты перемешений по странице и перерисовки. Select и Selection следует использовать только тогда, когда действительно нужно что то выделить. А все остальные действия производятся напрямую с необходимым диапазоном ячеек. Поэтому приведенный код я бы переписал так:

Код: Выделить всё

Dim oRange As Range

    Set oRange = Range("B25:K28")
    oRange.Borders(xlDiagonalDown).LineStyle = xlNone
    oRange.Borders(xlDiagonalUp).LineStyle = xlNone
    With oRange.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

Да, и обязательно используй Option Explicit
ОБЯЗАТЕЛЬНО!!!

[Pavlo]

вообще то я на JAVA учусь программировать а VBA еще в институте учил и использую для решения различных задач для оптимизации. Но спасибо за совет.

[Pavlo]

Насколько я помню то Option Explicit используется для описания глобальных переменных, что противоречит ООП. то есть если переменную я описал вне процедуры то она будет доступна всем? Я прав?

[alibek]

Option Explicit требует обязательного объявления переменной перед использованием.

[ger_kar]

вообще то я на JAVA учусь программировать а VBA еще в институте учил и использую для решения различных задач для оптимизации.

Тут дело даже не в VBA, как таковом, а в объектной модели самого Excel. На том же JAWA, или С++ если придется поработать с Excel, то придется действовать аналогично, естественно сам код будет другой, но принцип тот же.

[ger_kar]

Насколько я помню то Option Explicit используется для описания глобальных переменных, что противоречит ООП. то есть если переменную я описал вне процедуры то она будет доступна всем? Я прав?

Что делает Option Explicit написал alibek, только добавлю, что она (эта опция) влияет на все переменные, в т.ч. и на локальные уровня процедуры. Что же касается глобальный переменных, то их область видимости определяется разными факторами, такими например, как вид модуля в котором она будет использоваться и как она объявлена Public или Private.

[Pavlo]

Спасибо, понял в будущем буду стараться делать правильно, вот доделал свою программу, можете покритиковать А еще хотел чтобы ger_кар Вы написали мне переделанную процедуру PobydovaTabluci с использованием своего объекта:
Dim oRange As Range
Set oRange = Range("B25:K28")

[Pavlo]

Файл

[ger_kar]

У меня в моём Office 2003 не открывается

[Pavlo]

Код: Выделить всё

Sub Start()
Dim stricka As Integer
Dim perevGrupu As Variant
Dim sumOborotAD As Double
Dim sumPDV_AD As Double
Dim sumPDV_B As Double
Dim sumOborotB As Double
Dim kinTabl As Integer
Dim strN As Integer 'стрічка для заповнення в результуючій табл
Dim strDlaKonst As Integer ' Стрічка для заповнення констант яка може збільшуватись якщо буде дві і більше таблиці
Dim pochKonst As Integer
Dim oRange As Range

strDlaKonst = 0

stricka = 4
pochKonst = pochatokKonstant
Call PobydovaTabluci
kinTabl = kinecVhidTabl(1)
kinTabl = kinTabl + 3
strN = kinTabl + 3
Call vstavkaTabluci(kinTabl)
rez = Cells(stricka, 2).Value

If rez = "Z-отчет" Then
    stricka = 6
    rez = Cells(stricka, 2).Value
   
    Do While Cells(stricka, 2).Value <> ""
     perevGrupu = Cells(stricka, 3).Value
        If Cells(stricka, 2).Value = rez Then
   
   
            If InStr(1, perevGrupu, "Д") Or InStr(1, perevGrupu, "А") > 0 Then
                sumOborotAD = sumOborotAD + CDbl(Replace(Cells(stricka, 4).Value, ".", ","))
                sumPDV_AD = sumPDV_AD + CDbl(Replace(Cells(stricka, 5).Value, ".", ","))
            End If
   
            If InStr(1, perevGrupu, "В") > 0 Then
                sumOborotB = sumOborotB + CDbl(Replace(Cells(stricka, 4).Value, ".", ","))
                sumPDV_B = sumPDV_B + CDbl(Replace(Cells(stricka, 5).Value, ".", ","))
            End If
            ' заповняю таблицю
            '**********************************
            Cells(strN, 6).Value = sumOborotAD

            If sumOborotB = Null Or sumOborotB = 0 Then
             Cells(strN, 7).Value = "****"
            Else
              Cells(strN, 7).Value = sumOborotB
            End If

              Cells(strN, 8).Value = sumPDV_AD
            If sumPDV_B = Null Or sumPDV_B = 0 Then
              Cells(strN, 9).Value = "****"
            Else
              Cells(strN, 9).Value = sumPDV_B
            End If
           
            Cells(strN, 1).Value = "Каса " & Cells(stricka, 1).Value
           
            Set oRange = Range(Cells(strN, 1), Cells(strN, 1))
           
            With oRange.Font
                .Color = -16776961
                .TintAndShade = 0
                .Bold = True
            End With
           
            Cells(strN, 2).Value = rez
            Cells(strN, 3).Value = Cells(pochKonst + strDlaKonst, 4).Value
            Cells(strN, 4).Value = Cells(pochKonst + strDlaKonst, 5).Value
            Cells(strN, 5).Value = Cells(pochKonst + strDlaKonst, 6).Value
                           
        Else
        ' побудова нової таблиці і визначення нових меж  і стрічок
            rez = Cells(stricka, 2).Value
            sumOborotAD = 0
            sumPDV_AD = 0
            sumPDV_B = 0
            sumOborotB = 0
            strDlaKonst = strDlaKonst + 1
            kasa = kasa + 1
            kinTabl = kinecVhidTabl(1)
            kinTabl = kinTabl + 2
            strN = kinTabl + 3
            stricka = stricka - 1
            Call vstavkaTabluci(kinTabl)
        End If
 
    stricka = stricka + 1
   
Loop


' On Error GoTo perehid
' ActiveSheet.Shapes.AddPicture Filename:="C:\chto.jpg", linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=520, Top:=120, Width:=180, Height:=180
'perehid:
   
    Range("L1:L1").Select
    ActiveCell.FormulaR1C1 = "Ідея програми : Начальник АЗС 04/2 - Таловер А.В."
    Range("L2:L2").Select
    ActiveCell.FormulaR1C1 = "Реалізація ідеї : Колишній працівник - Куліненко П.О."
End If

End Sub
Function pochatokKonstant()
    Dim stov As Integer
    Dim strichka As Integer
    Dim vuhid As Boolean
    vuhid = False
    stov = 4
    strichka = 1
   
    Do While Cells(strichka, stov).Value <> "Сл. взнос"
       strichka = strichka + 1
       
       
    Loop
pochatokKonstant = strichka + 1

End Function
Function kinecVhidTabl(strich As Integer) As Integer
    Dim stov As Integer
    Dim lichulnuk As Integer
    Dim vuhid As Boolean
    lichulnuk = 0
    stov = 4
    vuhid = False
     Do While vuhid = False
        rez = Cells(strich, stov).Value
            If rez = "" Then
                kinecVhidTabl = strich
                Do While lichulnuk < 10
                    strich = strich + 1
                    rez = Cells(strich, stov).Value
                    If rez = "" Then
                        lichulnuk = lichulnuk + 1
                    Else
                        kinecVhidTabl = strich
                        Exit Do
                    End If
                Loop
           
            End If
            If lichulnuk = 10 Then
                Exit Do
            Else
                lichulnuk = 0
            End If
        strich = strich + 1
  Loop
   
   
End Function
Sub vstavkaTabluci(str As Integer)

Sheets("Лист1").Select
   
    Range("A1:J4").Select
    Selection.Copy
    Sheets("Книга РРО").Select
    Range(Cells(str, 1), Cells(str, 1)).Select
    ActiveSheet.Paste


End Sub

Sub PobydovaTabluci()
Sheets.Add After:=Sheets(Sheets.Count)
Range("A1:J4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1:A2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("B1:B2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("C1:D1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("E1:G1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("F2:G2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("H1:I2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("J1:J2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:A2").Select
    ActiveCell.FormulaR1C1 = "Дата"
    With ActiveCell.Characters(Start:=1, Length:=4).Font
        .Name = "arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("B1:B2").Select
    ActiveCell.FormulaR1C1 = "Номер" & Chr(10) & "Z-звіту"
    With ActiveCell.Characters(Start:=1, Length:=13).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("C1:D1").Select
    ActiveCell.FormulaR1C1 = "Сума готівки"
    With ActiveCell.Characters(Start:=1, Length:=12).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Службове внесення"
    With ActiveCell.Characters(Start:=1, Length:=17).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("C3").Select
    Columns("C:C").EntireColumn.AutoFit
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Службова" & Chr(10) & "видача"
    With ActiveCell.Characters(Start:=1, Length:=15).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E1:G1").Select
    ActiveCell.FormulaR1C1 = "Сума розрахунків"
    With ActiveCell.Characters(Start:=1, Length:=16).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Загальна"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("F2:G2").Select
    ActiveCell.FormulaR1C1 = "За ставкою ПДВ"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("H1:I2").Select
    ActiveCell.FormulaR1C1 = "Сума ПДВ"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("J1:J2").Select
    ActiveCell.FormulaR1C1 = "Видано" & Chr(10) & "при" & Chr(10) & "поверненні" & Chr(10) & "товару"
    With ActiveCell.Characters(Start:=1, Length:=28).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1:J4").Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Font
        .Name = "arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "20%"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "7%"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "20%"
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "7%"
   
    Sheets("Книга РРО").Select
End Sub


[Qwertiy]

Просто меняй такие конструкции

Код: Выделить всё

Range("J1:J2").Select
With Selection

на такие

Код: Выделить всё

With Range("J1:J2")