Главная страница
Навигация по странице:

  • Листинг 5.1.

  • Листинг 5.2.

  • Листинг 5.3.

  • Листинг 5.4.

  • Листинг 5.5.

  • Готовые макросы в VBA Excel (Миронов.) (z-lib.org). Запуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6


    Скачать 1.47 Mb.
    НазваниеЗапуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6
    Дата26.06.2022
    Размер1.47 Mb.
    Формат файлаdoc
    Имя файлаГотовые макросы в VBA Excel (Миронов.) (z-lib.org).doc
    ТипДокументы
    #615298
    страница37 из 47
    1   ...   33   34   35   36   37   38   39   40   ...   47

    ГЛАВА . ЮЗЕРФОРМЫ



    Мне кажется, наилучшим решениям для передачи данных штрихкода будет не TextBox, а Label, в него уже точно ничего руками не введешь

    По поводу выполнения макросов по кнопке, Юрий вам уже пример макроса показал, как прявязать к конкертной кнопке, примерно так:

    Private Sub TextBox10_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    if keyAscii = 27 then Call Macros1'выполнеие нужной процедуры по F1

    end sub

    номера обозначения кнопок можно посмотреть по процедуре

    Private Sub TextBox10_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    msgbox keyAscii

    end sub

    проверить введенное значение на соотвествие и пропустить или поставить дефолтное значение

    Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Val(TextBox1) > 10 And Val(TextBox1) < 10000 Then
    Else
    TextBox1 = 20 ' default value
    End If
    End Sub

    Разрешенные символы
    Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 44 Or KeyAscii = 45 Or KeyAscii = 8 Then Else KeyAscii = 0
    End Sub
    ‘ 44 Это запятая
    ‘ 46 точка

    Автоматическая замена точки на запятую

    Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Chr(KeyAscii) = "," Then KeyAscii = Asc(".")
    End Sub

    Если нужно заблокировать ввод запятой, то:
    ... Then KeyAscii = 0

    Ввод в TextBox только цифр

    Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
    KeyAscii = 0
    Beep ' звуковой сигнал при ошибке
    End If
    End Sub

    при использовании события change брать последний введенный символ. Елси подходит оставлять его, если нет - присваивать полю последнее значение

    Private Sub TextBox1_Change()
    lc = Right(TextBox1, 1)
    If lc < "0" And lc "9") Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
    End Sub

    при таком методе фсякие знаки, кроме цифр, в поле ввода даже не появляюцца! :)

    Ввод только цифр

    If Not IsNumeric(Me.TextBox1) Then
    Me.Hide
    MsgBox "Значение должно быть числом!"
    Me.Show
    End If
    Далее текст самой программы
    exit sub

    Глава . ДИАГРАММЫ

    Построение диаграммы с помощью макроса


    Листинг_5.1.'>Листинг 5.1. Макрос построения диаграммы

    Sub CreateChart()

    ' Создание и настройка диаграммы

    With Charts.Add

    ' Данные из первого листа

    .SetSourceData Source:=Worksheets(1).Range("A1:E4")

    ' Заголовок

    .HasTitle = True

    .ChartTitle.Text = "Выручка по магазинам"

    ' Активизируем диаграмму

    .Activate

    End With

    End Sub

    Листинг_5.2.'>Листинг 5.2. Построение внедренной диаграммы

    Sub CreateEmbeddedChart()

    ' Создание и настройка внедренной диаграммы

    With Worksheets(1).ChartObjects.Add(100, 60, 250, 200)

    ' Объемная диаграмма

    .Chart.ChartType = xl3DArea

    ' Источник данных

    .Chart.SetSourceData Source:=Worksheets(1).Range("A1:E4")

    End With

    End Sub

    Листинг 5.3. Создание диаграммы на основе выделенных данных

    Sub CreateCharOnSelection()

    ' Создание диаграммы (с заданием положения на листе)

    With ActiveSheet.ChartObjects.Add( _

    Selection.Left + Selection.Width, _

    Selection.Top + Selection.Height, 300, 200).Chart

    ' Тип диаграммы

    .ChartType = xlColumnClustered

    ' Источник данных - выделение

    .SetSourceData Source:=Selection, PlotBy:=xlColumns

    ' Без легенды

    .HasLegend = False

    ' Без заголовка

    .HasTitle = True

    .ChartTitle.Characters.Text = "Выручка за период"

    ' Выделение диаграммы

    .Parent.Select

    End With

    End Sub

    Сохранение диаграммы в отдельном файле


    Листинг 5.4. Сохранение диаграммы

    Sub SaveChart()

    ' Сохранение выделенной диаграммы в файл

    If ActiveChart Is Nothing Then

    ' Нет выделенных диаграмм

    MsgBox "Выделите диаграмму"

    Else

    ' Сохранение...

    ActiveChart.Export ActiveWorkbook.path & "\Диаграмма.gif", "GIF"

    End If

    End Sub

    Листинг 5.5. Сохранение диаграммы под указанным именем

    Sub InteractiveSaveChart()

    Dim strFileName As String ' Имя файла для сохранения

    ' Проверка, выделена ли диаграмма

    If ActiveChart Is Nothing Then

    ' Нет выделенных диаграмм

    MsgBox "Выделите диаграмму"

    Else

    ' Выбор файла для сохранения

    strFileName = Application.GetSaveAsFilename( _

    ActiveChart.Name & ".gif", "Файлы GIF (*.gif), *.gif", 1, _

    "Сохранить диаграмму в формате GIF")

    ' Проверка, выбран ли файл

    If strFileName <> "" Then

    ' Сохранение выделенной диаграммы в файл

    ActiveChart.Export strFileName, "GIF"

    End If

    End If

    End Sub
    1   ...   33   34   35   36   37   38   39   40   ...   47


    написать администратору сайта