Sub test()
x = Range("b1")
z = Len(x)
For i = 1 To z
Range("a1").Offset(i - 1, 0).Value = Mid(x, i, 1)
Next i
End Sub
上記は、"B1"に入力されているデータを、"A1"から下方向に一文字ずつ入力していくマクロです。
これに条件を付け加えたいのですが。
"今日(きょうは)雨[あめ]でした"のように、"( )"や"[ ]"内の文字はカッコも含めてフォントが赤(ColorIndex = 3)になるようにしたいのですが。
上の例だと、"(きょうは)"と"[あめ]"のフォントが赤になります。
おわかりの方がいましたら、お願いいたします。
エクセル２０００です。
あるブックにAAAという名前のワークシートが存在するかどうかの判定方法の質問です。
現在はそのブックを開き、
Sub test()
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "AAA" Then
flag = "ありまする。"
Else
flag = "ないでござる。"
End If
Next
MsgBox flag
End Sub
のように判定しています。
質問は、
１．開かずに判定することは可能かどうか？可能ならその方法
２．上記コードのように各シート総当り以外にシート名を検索する方法があるか？あるならその方法
です。よろしくお願いします。
いつもお世話になっています。
ExcelVBAでソフトを作っているのですが、
ユーザフォーム上のコンボボックスとセルの文字比較がうまくいきません。
コードは、
For i = 1 To 100
If Controls("ComboBox" & h).Value = Sheets("Sheet1").Cells(i, 8) Then
～ 処理 ～
Exit Sub
End If
Next i
としているのですが、文字と半角数字の組み合わせ「北1」等だとうまく処理に行くのですが、
半角数字のみ「1」だけだとコンボボックスとセルの値が同じでも
処理に行かず終了してしまいます。
セルの書式設定で文字列に指定しても変わりませんでした。
解決法がわからずに困っています。
お分かりの方いましたらご回答よろしくお願いします。
エクセル２０００です。
DATAと名づけた表の値を変換し、最大値から端数をプラマイするマクロなのですが、途中で「実行時エラー９１ オブジェクト変数またはWithブロック変数が設定されていません。」となってしまいます。
なぜ出るかわからないので別なBookに同じ名前のRange
をつくり同様の表でためしたらエラーにならずちゃんと作動します。
本番用のBookでのみエラーがでます。なぜなのでしょうか？
実行時エラーのでる
With Range("DATA").Find(mx, LookIn:=xlValues)
.Value = .Value + dff '
End With
を、Withブロックをつかわず
Range("DATA").Find(mx, LookIn:=xlValues).Select
で試しても本番のBookではエラーになります。ほんとに困っています。
Sub 調整()
Dim r As Double
Dim c As Range
Dim dff As Integer, mx As Long
r = 25000 / Range("初期").Value
With Sheets("内訳")
Range("DATA").Value = .Range("F57:L73").Value '初期値複写
'MsgBox "初期値転写完了"
For Each c In Range("DATA")
If c.Value <> "" Then
c.Value = Application.WorksheetFunction.Round(c.Value * r, -1)
End If
Next
'MsgBox "初期変換完了"
dff = 25000 - Range("変換後")
If dff <> 0 Then
'MsgBox dff
mx = Application.WorksheetFunction.Max(Range("DATA"))
'MsgBox mx
With Range("DATA").Find(mx, LookIn:=xlValues)
.Value = .Value + dff 'ここで実行時エラー!
End With
End If
End With
End Sub
シート上に複数のグループ化したオートシェイプがあり、
それを一括して消すマクロを組みました。
その時、シート上のボタンまで消してしまわないようTypeで判断しています。
Dim Sp As Shape
For Each Sp In Shapes
If Not Sp.Type = 12 Then
Sp.Delete
End If
Next
簡単な図形であれば、数百個でも問題ありません。
また、複雑な図形でも数個であれば正常に動作します。
これが、複雑な図形が数十個になると、
"Tyepメソッドは失敗しました。"とエラーが表示されExcel自体が強制終了します。
１、２回で出ないこともたまにありますが、何度か繰り返しますと確実に出ます。
原因が特定できず困っています。
推測や可能性でもかまいません、どうぞよろしくお願いいたします。
※複雑な図形とはフリーハンドを組み合わせたような絵です。（人物の顔など）
動作はWindows2000のEXCEL2000で２台
WindowsXPのEXCEL2003で１台でテストしました。
シート上に複数のグループ化したオートシェイプがあり、
それを一括して消すマクロを組みました。
その時、シート上のボタンまで消してしまわないようTypeで判断しています。
Dim Sp As Shape
For Each Sp In Shapes
If Not Sp.Type = 12 Then
Sp.Delete
End If
Next
簡単な図形であれば、数百個でも問題ありません。
また、複雑な図形でも数個であれば正常に動作します。
これが、複雑な図形が数十個になると、
"Tyepメソッドは失敗しました。"とエラーが表示されExcel自体が強制終了します。
１、２回で出ないこともたまにありますが、何度か繰り返しますと確実に出ます。
原因が特定できず困っています。
推測や可能性でもかまいません、どうぞよろしくお願いいたします。
※複雑な図形とはフリーハンドを組み合わせたような絵です。（人物の顔など）
動作はWindows2000のEXCEL2000で２台
WindowsXPのEXCEL2003で１台でテストしました。
エクセルに地図を貼り付け、その中のある地点Aから半径１キロ、２キロ、３キロといった具合に円を描いています。ある地点B、Cも同様に円があります。セルに“A”
と入力した際に該当する地点の円（１キロ、２キロ、３キロの3種類）を赤く表示し、終了すると円が消える（線なしに変わる）ようにするために以下のようなＶＢＡを組みました。が、円が２つしか赤くならなかったり、
ばあいによっては「インデックスが境界を超えています」とエラーが出たりします。
どうしたら良いか教えてください。
Sub iro()
Dim i As Variant
i = InputBox("表示する地点を指定してください", "地点指定")
If i = "A" Then
ActiveSheet.Shapes(1).Select
ActiveSheet.Shapes(2).Select
ActiveSheet.Shapes(3).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(1).Select
ActiveSheet.Shapes(2).Select
ActiveSheet.Shapes(3).Select Replace:=False
modosu
ElseIf i = "B" Then
ActiveSheet.Shapes(4).Select
ActiveSheet.Shapes(5).Select
ActiveSheet.Shapes(6).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(4).Select
ActiveSheet.Shapes(5).Select
ActiveSheet.Shapes(6).Select Replace:=False
Else
MsgBox "指定した地点がありません", vbOKOnly
End If
End Sub
Sub hyoji()
Selection.ShapeRange.Line.Visible = msoTrue
'「線なし」に設定されている場合、線を表示
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Range("A1").Select
End Sub
Sub modosu()
Selection.ShapeRange.Line.Visible = msoFalse
'「線なし」に設定
Range("A1").Select
End Sub
ShapeのVBAの中での取り扱いに関して、サジェスチョン願います。
Shapeに文字が書き込まれていない段階で、選択して文字を読み込み判定しようとするとエラーとなります。
下記のVBAでは、5番目のShapeが該当します。
このエラーを防ぐためには、On Error Resume Nextが有効ですが、他の方法を探しています。例えば、charactor=trueみたいなもの。
-----
Sub Shapeの調査()
Dim nametemp(10) As String
Dim temp As Integer
Dim i As Integer
Dim aaa As Variant
'On Error Resume Next
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 50, 50).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 150, 150, 50, 50).Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 200, 200, 50, 50).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, 250, 250, 50, 50).Select
temp = ActiveSheet.Shapes.Count
For i = 1 To temp
ActiveSheet.Shapes(i).Select
nametemp(i) = ActiveSheet.Shapes(i).Name
Next
For i = 1 To temp / 2 + 1 '4つのshapeに対し、文字を書き込もうとする
ActiveSheet.Shapes(nametemp(i)).Select
Selection.Characters.Text = ""
Next
For i = 1 To temp / 2 '3つに対して、文字を書き込む
ActiveSheet.Shapes(nametemp(i)).Select
Selection.Characters.Text = "zzzzz"
Next
For i = 1 To temp
ActiveSheet.Shapes(nametemp(i)).Select
aaa = Selection.Characters.Text '<--5番目のShapeに対し
If aaa = "zzzzz" Then MsgBox (aaa)'<--errorとなる。
Next
End Sub
調べたところ
Sub test()
Dim i As Integer
i = ActivePresentation.Slides.Count
For i = 1 To i
With ActivePresentation.Slides(i).NotesPage
.Shapes.Placeholders(2).TextFrame.TextRange = ""
End With
Next i
End Sub
というマクロでいけるそうなのですが、幾つか試すと
「実行時エラー '2147188160(80048240)」':
Placeholders(不明なメンバー）：範囲外の整数2は次の有効な範囲にありません:1から１へ」
というエラーで停まるものがあります。
これの回避方法をご存知の方がいたら教えてください。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim GYO As Long
' ８列目のみを対象とする
If Target.Column <> 8 Then
Exit Sub
Else
GYO = Target.Row
End If
' ８列目が空欄でなければ計算処理を呼び出す(引数は選択行)
If Cells(GYO, 8).Value = "" Then
Exit Sub
Else: Call KEISAN(GYO)
End If
End Sub
という方法で８列目のセルをクリックするとフォームが立ち上がるようにしているのですが、ドラッグによる範囲選択でも８列目が含まれているとフォームが立ち上がってしまいます。
単一セルの選択時のみにするにはどうしたらいいでしょうか。
それとすべてのシートにこのマクロを書いているのですがworkbook全体でやることはできないのでしょうか？
Workbookのところにこのコードを入れてもうまくいきませんでした。
