書式操作
セル幅
条件付書式
・
・
サイズ
色の一覧
RGB 参考サイト
color 参考サイト
colorindex 参考サイト
色取得
転記
リンク操作
クリック操作
- ダブルクリックで色つけ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'BeforeDoubleClick, Cancel As Boolean
If Not Application.Intersect(ActiveCell, Range("C3:C1500")) Is Nothing Then
Cancel = True '入力無効
With ActiveCell.Interior
If .ColorIndex = xlNone Then
.ColorIndex = 38
ElseIf .ColorIndex = 38 Then
.ColorIndex = 36
ElseIf .ColorIndex = 36 Then
.ColorIndex = 35
ElseIf .ColorIndex = 35 Then
.ColorIndex = xlNone
End If
End With
End If
- クリックで文字入れ
- クリックで文字転記
シート名は変えて使ってください。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'BeforeDoubleClick, Cancel As Boolean
If Not Intersect(Target, Range("D3:D1500")) Is Nothing Then
S_title = Target.Offset(0, -2).Value & Target.Offset(0, -1).Value
S_jyo = Target
ri = ActiveCell
S_dai = ActiveCell.Offset(0, -2).Value
Target.Offset(0, 1).Copy
Debug.Print S_jyo
k = 1
Do While Worksheets("問題出力先").Range("B" & k) <> ""
k = k + 1
If Worksheets("出力先").Range("B" & k) = "" Then
Worksheets("出力先").Range("A" & k) = S_title
Worksheets("出力先").Range("B" & k) = S_jyo
'Worksheets("出力先").Range("C" & K) = S_con
Worksheets("出力先").Range("C" & k).PasteSpecial (xlPasteAll)
'Worksheets("出力先").Range("D" & k) = S_con
Debug.Print
MsgBox "出力先に追加しました"
Cancel = True '入力無効
Exit Do
End If
Loop
End If
ユーザフォーム操作
If Not Intersect(Target, Range("F3:F300")) Is Nothing Then
Cancel = True
Dim Tx1 As Long, Lx1 As Long, Wx1 As Long, Hx1 As Long
With ActiveWindow
Tx1 = .Top
Lx1 = .Left
Wx1 = .Width
Hx1 = .Height
End With
' ** ユーザーフォームをロード
Load インデックス
'** UFのサイズを取得
Dim Tx2 As Long, Lx2 As Long, Wx2 As Long, Hx2 As Long
With インデックス
Wx2 = .Width
Hx2 = .Height
End With
'** ユーザーフォームの表示位置を計算
Tx2 = Tx1 + ((Hx1 - Hx2) / 2)
Lx2 = Lx1 + ((Wx1 - Wx2) / 2)
'** ユーザーフォームを表示
With インデックス
.StartUpPosition = Manual '**Top,Leftを指定するときに必ず必要
' これがないとLeftがずれます
.Left = Lx2 '**X座標
.Top = Tx2 '**Y座標
.Show '**ユーザーフォームを表示
End With
End If
- 文字置換
- 指定文字で色つけ
- 色一覧
- フィルタ機能 重複なし
Dim items() As Variant
Dim i As Integer
Dim tmp As String
Dim itemsStr As String
tmp = ""
itemsStr = ""
' 商品名取得
items = WorksheetFunction.Transpose(Range("B6:B13").Value) ★
' 重複しない商品名をカンマ区切り文字列に変換
For i = 1 To UBound(items)
If tmp <> items(i) Then
itemsStr = itemsStr & items(i) & ","
tmp = items(i)
End If
Next
' ドロップダウンリスト作成
With Range("B3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Left(itemsStr, Len(itemsStr) - 1)
End With
- ワード表へ転記
グラフ操作
グラフの適用
Sub Sample() Dim LastCell As Range, i As Long Set LastCell = Cells(Rows.Count, 1).End(xlUp) With ActiveSheet.ChartObjects(1).Chart For i = 1 To .SeriesCollection.Count .SeriesCollection(i).Formula = _ "=SERIES(" & Cells(1, i + 1).Address(External:=True) & "," & _ Range(Cells(2, 1), LastCell.Offset(0, 0)).Address(External:=True) & "," & _ Range(Cells(2, i + 1), LastCell.Offset(0, i)).Address(External:=True) & "," & _ i & ")" Next i End With End Sub
「ActiveChart.Parent」と.Nameの組み合わせ
コメント