セルの値をテキストボックスへ記入及び名前変更
- セルの値をテキストボックスに追加し、図形名を同じ値にしたい
- 選択したセルに丸オートシェイプを挿入し、テキストで追加する方法
- セルの値を読み込むにはどのようにすれば良いか
- ベストアンサー
セルの値をテキストボックスへ記入及び名前変更
範囲選択したセルに丸オートシェイプを挿入すると共に、それぞれのセルの値をテキストで追加及び、図形名を同じ値にしたいと思っています（下記の＊＊＊の部分）。この時セルは結合されている場合があります。 描写は下記のようにしたのですが、セルの読み込みで詰まってしまいました。セルの値を読み込むにはどの様なしたらいいのでしょうか？ 宜しくお願い致します。 Sub 選択されたセルに丸テキスト挿入() Dim X As Double Dim Y As Double Dim L As Double Dim c As Range If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection With c.MergeArea If c.Address = .Item(1).Address Then L = IIf(.Width > .Height, .Height, .Width) X = .Left + (.Width - L) / 2 Y = .Top + (.Height - L) / 2 ActiveSheet.Shapes.AddShape(msoShapeOval, X, Y, L, L).Select Selection.Name = ＊＊＊ Selection.Characters.Text = "＊＊＊" Selection.ShapeRange.Fill.Visible = msoFalse Selection.HorizontalAlignment = xlCenter With Selection.Characters(Start:=1, Length:=3).Font .Size = 8 End With End If End With Next End Sub
- ae-1sp
- お礼率75% (92/122)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
= "＊＊＊" を、 = c.Value にするだけでは？
関連するQ&A
- エクセル マクロ
エクセルのある特定のセルをダブルクリックすると 画像ファイルを参照しにいき 貼りつけたい画像ファイル選ぶと そのセルの大きさに合わせて 画像ファイルがそのセルに 貼りつくというマクロが以下の通りなんですが Excel2003からExcel2007へ変更すると 画像ファイルの貼りつく位置がダブルクリックしたセルではない所に 貼りつくようになりました 参照や大きさなどはちゃんと機能しているようです どこを変更すればよいでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range('特定のセル)) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 .Top = .Top + (myRange.Height - .Height) / 2 End With Application.ScreenUpdating = True Cancel = True End Sub
- ベストアンサー
- オフィス系ソフト
- 図形消去後に文字入力(エクセル）
Sub test() Dim c As Range If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection With c.MergeArea wTop = .Top wLeft = .Left wBottom = .Top + .Height wRight = .Left + .Width End With For Each s In ActiveSheet.DrawingObjects With s If wTop <= .Top And _ wLeft <= .Left And _ wBottom >= .Top + .Height And _ wRight >= .Left + .Width Then .Delete End If End With Next Next End Sub 上記マクロは、選択状態になっている個々のセルの中に、すっぽり収まる状態で存在しているオブジェクトを消去します。 オブジェクトが消去されたセルに、"○"が入力されるようにしたいのですが。 どういった記述が必要になるでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセル２００７のVBAの困りごと
教えてください。 画像挿入時にエクセルのセルの大きさに合わせるマクロを使っているのですが、エクセル２０００、２００３では問題なく動くのですが、２００７だと、うまくVBAが動かず、画像が縮小・拡大されません。 わかるかた教えてください。 コード Dim c As Range, cm As Range Application.ScreenUpdating = False For Each c In Selection Set cm = c.MergeArea If c.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing
- 締切済み
- オフィス系ソフト
- Excelセル範囲内の値のみ1行空欄にする
下記コードでは1行づつ挿入により下段までずれてしまいます。 Excelセル範囲内の値のみ1行づつ開けるにはどのようにすれば良いでしょうか。 どなたか解る方よろしくお願いします。 Sub 空欄1行() Dim i As Long If TypeName(Selection) <> "Range" Then Exit Sub With Selection For i = .Rows.Count To 2 Step -1 Intersect(.Cells(i, 1).EntireRow, .Columns).Insert xlDown Next End With End Sub
- ベストアンサー
- Visual Basic
- Excelの写真貼り付け(90度回転)について
xcelに写真のサイズを自動的に変更するマクロ、(セルの大きさに合わせて）を利用しています。 このマクロに対して写真を90度角度を変更して、写真を表示させたいのですが、どのようにすればよいのでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) ActiveSheet.Unprotect Dim C As Range, cm As Range Application.ScreenUpdating = False For Each C In Selection Set cm = C.MergeArea If C.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing Application.ScreenUpdating = True Range("a1").Select End Sub
- 締切済み
- その他MS Office製品
- エクセルのマクロで画像を貼り付け
画像をエクセルに貼り付ける作業を行っています。 マクロを使いファイル内の画像（約３０枚程度）を１列づつスペースを空け 右方向に４枚 １行スペースを空け ３行目の左に戻り その位置よりまた１列づつスペースを空け右方向に４枚・・・・・ これを繰り返しファイル内の画像をすべて 貼り付けたいのですがうまく動作が出来ません。 何卒ご教授の程よろしくお願いします。 ※マクロ Sub EggFunc_pasteDirImage() ' 変数定義 Dim fileName As String Dim targetCol As Integer Dim targetRow As Integer Dim targetCell As Range Dim shell, myPath Dim pos As Integer Dim extention As String Dim isImage As Boolean ' 選択セルを取得 targetCol = ActiveCell.Column targetRow = ActiveCell.Row ' フォルダ選択画面を表示 Set shell = CreateObject("Shell.Application") Set myPath = shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\Users\0602116.MS\Desktop\") Set shell = Nothing ' フォルダを選択したら... If Not myPath Is Nothing Then fileName = Dir(myPath.Items.Item.Path + "\") Do While fileName <> "" ' ファイル拡張子の判別 isImage = True pos = InStrRev(fileName, ".") If pos > 0 Then Select Case LCase(Mid(fileName, pos + 1)) Case "jpeg" Case "jpg" Case "gif" Case Else isImage = False End Select Else isImage = False End If ' 拡張子が画像であれば If isImage = True Then ' 貼り付け先を選択 Cells(targetRow, targetCol).Select Set targetCell = ActiveCell ' 画像読込み ActiveSheet.Pictures.Insert(myPath.Items.Item.Path + "\" + fileName).Select ' 画像が大きい場合、画像サイズをセル幅に合わせる If Selection.Width > targetCell.Width Or Selection.Height > targetCell.Height Then If Selection.Width / targetCell.Width > Selection.Height / targetCell.Height Then Selection.Height = Selection.Height * (targetCell.Width / Selection.Width) Selection.Width = targetCell.Width Else Selection.Width = Selection.Width * (targetCell.Height / Selection.Height) Selection.Height = targetCell.Height End If End If ' 表示位置をセル中央に移動 Selection.Top = targetCell.Top + (targetCell.Height - Selection.Height) / 2 Selection.Left = targetCell.Left + (targetCell.Width - Selection.Width) / 2 ' 貼り付け先行を+1 targetCol = targetCol + 2 End If fileName = Dir() Loop MsgBox "画像の読込みが終了しました" End If End Sub
- ベストアンサー
- Visual Basic
- セル解除後、各行に値をコピーし結合するマクロ
A1からC3のセルが結合しており、 そのセル結合を解除すると、A列のみ値がコピーされる。 コピーした後、各行ごとにセルを結合していく…… という処理をしたいと思い、 調べて下記のマクロまでなんとかこぎつけました。 Sub セル結合() Dim date1 As Variant Dim range1 As Range Application.DisplayAlerts = False For Each range1 In Selection.Rows If range1(1).MergeCells = False Then range1(1).Merge Else date1 = Selection.Rows(1).Value With range1 .UnMerge .WrapText = False .ShrinkToFit = False Selection.Value = date1 End With End If Next range1 End Sub ※実行範囲に関しては、 任意選択をした範囲にしたいため、 range(1)にて処理を行いました。 困っているのは、上記のマクロを実行すると、 最初の行のみ結合できないということ。 もうひとつが、 セル結合をしない時に値を左端にコピーすると、 文字が自動縮小されてしまいます。 縮小しないようにするには、 どのような処理を入れたら良いでしょうか？ お力添え頂けますと幸いです。 よろしくおねがいします。
- ベストアンサー
- オフィス系ソフト
- VBAのフォーム上にTextBoxたくさんあるとき
Microsoft Excel 2013 の VBAのフォーム機能を利用してます。 TextBoxにセルを参照して文字が入ってくるようにしています。、 参照するセルによって文字列の長さが違うので 文字の大きさを自動調整してくれるマクロを使っているのですが TextBoxがいっぱいあるため、以下のように非常に長いプログラムになってしまいました。 Private Sub textBox1_Change() Const InitialFontSize As Double = 40 '初期フォントサイズ Dim BufWidth As Double Dim BufHeight As Double With Me.TextBox1 .Font.Size = InitialFontSize BufWidth = .Width BufHeight = .Height .AutoSize = True While .Width > BufWidth .Font.Size = .Font.Size - 2.5 Wend .AutoSize = False .Width = BufWidth .Height = BufHeight End With End Sub TextBox2～67は繰り返し Private Sub textBox67_Change() Const InitialFontSize As Double = 40 '初期フォントサイズ Dim BufWidth As Double Dim BufHeight As Double With Me.TextBox67 .Font.Size = InitialFontSize BufWidth = .Width BufHeight = .Height .AutoSize = True While .Width > BufWidth .Font.Size = .Font.Size - 2.5 Wend .AutoSize = False .Width = BufWidth .Height = BufHeight End With End Sub 過去の質問等を参考にいろいろ試してみたのですが 自分の力不足でうまくできませんでした。 うまくまとめられるような方法等ありましたらお知恵を拝借できないでしょうか よろしくお願い致します
- ベストアンサー
- SE・インフラ・Webエンジニア
- エクセルVisualBasicマクロ詳しい方
写真を特定のセルに貼り付けるのにダブルクリックでマイドキュメントがでるようにし、 写真を貼り付けるとサイズを枠に調節するようにマクロをつくりました。 問題なく出来るようになったのですが、 ダブルクリックでマイドキュメントではなく、 別の場所を指定するにはどこをどう変えればいいですか？ 現状は以下の通りです。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Union(Range("A1:A21"))) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range '画像を配置するセル範囲 Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 'このセル範囲に収まるように画像を縮小する Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 End With Application.ScreenUpdating = True Cancel = True End Sub
- ベストアンサー
- オフィス系ソフト
- テキストの値を、セルの値に取り込みたい。
すみません。誰か教えて頂けませんか。 エクセルの値を、テキストファルに出力する事が出来たのですが、 この値を、同じセル位置に取り込み操作をマクロで記述したいのですが、 どうやっても分かりません。 誰か教えて頂けませんでしょうか。 出力記述を下記に記入させて頂きます。 Sub 記録() Dim myFileNo As Integer Dim i As Long Dim y As Long Dim myLastRow As Long Dim IMA As String IMA = Format(Now, "yyyy.mm.dd.ss") & ".txt" Worksheets("Sheet1").Activate myLastRow = Range("A51").CurrentRegion.Rows.Count myFileNo = FreeFile Open "D:¥" & IMA For Output As myFileNo For i = 50 To 64 For y = 1 To 64 Write #myFileNo, Cells(i, y), Next y Next i Close #myFileNo End Sub 空欄と値はカンマ区切りで出力されます。 すみません、宜しくお願いします。
- ベストアンサー
- その他MS Office製品
お礼
できました！ これは便利ですね！ ありがとうございました。