Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 06.02.2018
• Размер: 1.35 Mb.
• Имя файла: 33980_7d1642e70814394f108d07a8a2edd23e.doc
• Тип: Документы; #35930
• страница: 37 из 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