Option Explicit
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789
Private IndexColors As New Collection, CurrentColor As Integer, BaseSheetIndex As Byte
Sub DuplicatesColoring()
Dim cell As Range, selected As Range
Set selected = Selection
If BaseSheetIndex = 0 Then _
BaseSheetIndex = ActiveSheet.Index: CurrentColor = 3 ' Начальные значения
selected.Interior.ColorIndex = -4142 ' Убрать заливку
For Each cell In selected
If Not IsEmpty(cell.Value) Then
On Error Resume Next ' Включить обработку исключений
If BaseSheetIndex = ActiveSheet.Index _
And WorksheetFunction.CountIf(selected, cell.Value2) > 1 Then
IndexColors.Add CurrentColor, CStr(cell.Value2) ' Заполнить коллекцию
If Not Err.Number = 457 Then CurrentColor = CurrentColor + 1
End If
cell.Interior.ColorIndex = IndexColors(CStr(cell.Value2))
On Error GoTo 0
End If
Next cell
Do Until ActiveSheet.Index > ActiveWorkbook.Sheets.Count - 1
ActiveWorkbook.Sheets(ActiveSheet.Index + 1).Activate
DuplicatesColoring
Exit Sub ' Предотвратить бесконечную рекурсию
Loop
Worksheets(BaseSheetIndex).Activate
End SubWith Selection.ParagraphFormat
.LineSpacingRule = wdLineSpaceSingle
.FirstLineIndent = CentimetersToPoints(1.6)
End WithLong используется для хранения чисел от -2147483648 до 2147483647. Для бóльших значений используется тип Double (или Currency для денежных единиц), но свыше 15 знаков точность числа с плавающей точкой будет падать. Неопределённый тип можно преобразовать программно CDec("24,0") в Decimal (16 байт). Эквивалентное написание:CLng(24) = 24& ' 4 байт
CLngLng(24) = 24^ ' 8 байт - только для x64
CDbl(24) = 24# ' 8 байт
CCur(24) = 24@ ' 8 байтSheets.Shapes.Item(1) есть свойство Left и Top, если второе задаётся значением высоты строки, то первое зависит от множества других параметров. Картинка находится не в ячейке, как это кажется на первый взгляд. Поэтому лучше сразу задавать рисунку имя Shapes.Item(1).Name.sh2.Shapes.Item(1).Copy
sh1.Pictures.PasteSub Auto_Open(). Для документа в его модуле нужно использовать процедуру Sub Document_Open().
3060 X1=100:Y1=160 3060 X1=100:Y1=160 3060 X1=180:Y1=160
3070 X2=260:Y2=160 3070 X2=340:Y2=160 3070 X2=400:Y2=160
3080 X3=180:Y3=21.4 3080 X3=260:Y3=21.4 3080 X3=250:Y3=419.8Нужно чтобы в чекбоксах выдавало статус checked/uncheckedВ примере по ссылке свойство
myabsent.Value имеет тип boolean.То тогда как переконвертировать в integer?Для изменения типа на
long необходимо изменить параметр на myabsent.TripleState = True ' Тройное состояние. Решение задачи.
Option Explicit
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789
Sub TestADO()
Dim Conn As Object, Rec As Object
On Error GoTo ErrMsg ' Создание подключения через драйвер
Set Conn = CreateObject("ADODB.Connection") ' Открываем Connection
Conn.ConnectionTimeout = 5
Conn.Mode = 1 ' 1 = adModeRead, 2 = adModeWrite, 3 = adModeReadWrite
Str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & $dbPath & ";"
' Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1""
'Str = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & $dbPath & ";"
'Str = Str & "Jet OLEDB:Engine Type=6;" ' Тип подключения (не используется)
Str = Str & "Jet OLEDB:Encrypt Database=False;"
Str = Str & "Jet OLEDB:Database Password=" & $passDB & ";"
' Системная таблица Access 2003 (файлы *.mdb)
'Str = Str & "Jet OLEDB:System database=" & $mdwPath
Conn.Open ConnectionString:=Str ', UserId:="$admin", Password:=""
Debug.Print "Conn.State="; Conn.State
Set Rec = CreateObject("ADODB.Recordset") ' Создаём RecordSet для чтения данных
' ...
Set Rec = Nothing: Set Conn = Nothing
On Error GoTo 0: Exit Sub
ErrMsg:
MsgBox Str & String(2, vbCrLf) & "Provider=" & Conn.Provider, _
vbOKOnly + vbCritical, "Error: " & Err.Number & ", AppVer: " _
& Val(Application.Version): Set Rec = Nothing: Set Conn = Nothing
End SubCells.Replace What:=Selection.Value