エクセルマクロでテキストファイルを貼り付ける方法| OKWAVE

エクセルマクロ

マクロで外部参照などを出す場合に Escボタンを途中で押すと中断し下記の添付画像のような表示が出ます。途中でキャンセルした場合(Escなど？) 画像のようなエラーを出さずにエラー(コメントを作る)メッセージを表示させて作業を中断することは可能でしょうか？可能な場合、下記のどの部分に追加するといいでしょうか？下記はテキストファイルを参照しエクセルに貼り付けるというマクロです Private Sub CommandButton1_Click() 　Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim vrtSelectedItem As Variant With fd Dim txtpass As Variant If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems txtpass = "TEXT;" & vrtSelectedItem Next vrtSelectedItem Else End If End With With ActiveSheet.QueryTables.Add(Connection:= _ txtpass, Destination:=Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)) .Name = "4" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ , 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub

エクセル　マクロ

以下のコードではテキスト(ｔｘｔ)ファイルのデータをエクセルへ貼りつけるものですが貼りつけるテキストファイルを参照し選ぶ際、テキストファイル以外を選ぶとエラーが起きてしまいますテキストファイル以外を選んで実行した場合はメッセージボックスを表示するようにはどうすればよいですか？ Private Sub CommandButton1_Click() Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim vrtSelectedItem As Variant With fd Dim txtpass As Variant If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems txtpass = "TEXT;" & vrtSelectedItem Next vrtSelectedItem Else MsgBox "キャンセルされました" Exit Sub End If End With With ActiveSheet.QueryTables.Add(Connection:= _ txtpass, Destination:=Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)) .Name = "4" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 2 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(2, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub

エクセルのマクロについて

エクセル2010を使用しています。工程表を作成するため、以下のマクロを組もうと苦戦しています。任意のセルを選択し、マクロを実行すると選択したセルに線を引き線の上部にテキストボックスで文字を入力できるようにするマクロを作成しようとしています。また、テキストボックスは文字入力後、大きさの自動調整をかけようとしています。線を引くところまでは、うまくいったのですがテキストボックスの挿入→入力待機 →入力後、大きさの自動調整（幅）までのマクロがよくわかりません。可能であれば、任意の選択したセルの中央に配置をしたいです。お知恵をお貸しください。よろしくお願いします。 koutei() Dim SentakuTop As Single Dim SentakuLeft As Single Dim SentakuWidth As Single Dim SentakuHeight As Single Dim SentakuAddress As String Dim X0, Y0, X1, Y1 As Variant SentakuAddress = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False) With ActiveSheet.Range(SentakuAddress) SentakuTop = .Top SentakuLeft = .Left SentakuWidth = .Width SentakuHeight = .Height End With X0 = SentakuLeft Y0 = SentakuTop + SentakuHeight / 2 X1 = SentakuLeft + SentakuWidth Y1 = Y0 With ActiveSheet.Shapes.AddLine(X0, Y0, X1, Y1).Line .ForeColor.RGB = RGB(0, 0, 0) .Weight = 1 .BeginArrowheadStyle = msoArrowheadOval .EndArrowheadStyle = msoArrowheadOval End With End Sub

エクセル　マクロ　初心者です

エクセルマクロ初心者です。以下の２つの Private Sub Worksheet_Change(ByVal Target As Range)を１つのシートで実行させたいのですが、当方、初心者なので組み合わせ方が分かりません。よろしくお願いします。 ===No1=== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target = StrConv(Target, vbUpperCase) Application.EnableEvents = True End Sub ===No2=== Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("コピーは禁止!!", vbCritical) MsgBox "データを消去します。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If If Target.Count = 1 Then Exit Sub Else MsgBox “複数セルのコピー禁止！" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub ------------ 上記の２つを１つのシートで動作させたいのですが、うまくいきません。単体では、動作します。

Excelマクロのオフセットについて

マクロのセルのオフセットについて質問です。複数の画像（仮に7枚）を一度に張り付ける際に If ActiveCell.Column = 1 Then ActiveCell.Offset(, 8).Select Else ActiveCell.Offset(4, -8).Select End If このようなマクロ組むと 1　2 3　4 5　6 7 という感じになります。列は8列空いて、行は4行空くことになると思うのですがこれを 1　2　3 4　5　6 7 としたい場合はどのようなマクロの書き方をすればよいのでしょうか？ご指導の程宜しくお願いします。マクロを張り付けておきます。 Declare Function SetCurrentDirectory Lib "kernel32" Alias _ "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long Sub 画像一括貼り付け() Dim Fname As Variant, fe As Variant Dim Fn As Variant, Pic As Shape Dim pno As Long Dim myFileName As String Range("A8").Select SetCurrentDirectory "P:\投レ＋相模原\F-POT KBB42365\外観確認" Fname = Application.GetOpenFilename _ ("jpg,*.jpg,jpeg,*.jpeg,bmp,*.bmp,gif,*.gif,png,*.png", MultiSelect:=True) If Not IsArray(Fname) Then MsgBox "取り消されました。", vbInformation Exit Sub End If Application.ScreenUpdating = False pno = 0 For Each Fn In Fname 'この次へ追加すべき行 Selection.Offset(-1, 0) = Mid(Fn, InStrRev(Fn, "\") + 1, Len(Fn) - InStrRev(Fn, "\")) ActiveCell.Select Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=Fn, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=0, Top:=0, Width:=360, Height:=270) With Pic .ScaleWidth 1, msoTrue .ScaleHeight 1, msoTrue .Top = ActiveCell.Top ' 位置：アクティブセルの上側に重ねる .Left = ActiveCell.Left ' 位置：アクティブセルの左側に重ねる .Placement = xlMove ' 移動するがサイズ変更しない End With If ActiveCell.Column = 1 Then ActiveCell.Offset(, 8).Select Else ActiveCell.Offset(4, -8).Select End If Set Pic = Nothing pno = pno + 1 Next Application.ScreenUpdating = True Range("A1").Select MsgBox pno & "枚の画像を挿入しました", vbInformation End Sub

このマクロの説明をお願いします

Dim buf As String Private Sub CommandButton1_Click() End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim tmp As Variant Application.EnableEvents = False tmp = InStr(2, buf, "$", vbTextCompare) tmp = Right(buf, Len(buf) - tmp) If buf = "$B$" & tmp Then Range("C" & tmp).Value = Range("C" & tmp).Value + Range("B" & tmp).Value Range(buf).Select End If Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As　Excel.Range) buf = ActiveCell.Address End Sub どうやらB列の各セルに入力がされた場合、隣接するC列のセルに加算していくマクロのようです。なんですが、 InStr関数、Right関数、Len関数あたりでやっていることがよくわかりません。 Private Sub CommandButton1_Click()は必要なのでしょうか？あと、もっとシンプルなマクロができるようでしたらご教授ねがいます。

画像をエクセルに貼り付けるマクロ

画像をエクセルに貼り付けるマクロ複数の画像をエクセルに貼り付ける機会が多く、下記のマクロを利用しています。これは他人が作ったものでその人が今はいないため修正の仕方がわかりません。これだとヨコに2個の画像で縦方向に画像が貼り付けられます。これをヨコに3個の画像で縦方向に画像を貼り付けるようにしたいのですが、方法がわかりません。お詳しい方どうかよろしくお願いします。＜現在＞１　　２３　　４５　　６＜やりたいこと＞１　　２　　３４　　５　　６７　　８　　９ Sub Insertpic() Dim strFilter As String Dim Filenames As Variant Dim pic As picture Dim sc As Range Dim i As Long Dim j As Long Dim k As Long '「ファイルを開く」ダイアログでファイル名を取得 strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png" Filenames = Application.GetOpenFilename( _ FileFilter:=strFilter, _ Title:="画像の挿入(複数画像が選択できます）", _ MultiSelect:=True) If Not IsArray(Filenames) Then Exit Sub ' 貼り付け開始セルを選択 'ActicveCellRange("C5").Select ' マクロ実行中の画面描写を停止 Application.ScreenUpdating = False ' 順番に画像を挿入 For i = LBound(Filenames) To UBound(Filenames) Set pic = ActiveSheet.Pictures.Insert(Filenames(i)) '画像の大きさ指定 With pic.ShapeRange .Height = 120# .Width = 175# .Rotation = 0# End With ' 次の貼り付け先を選択 Select Case i Mod 2 Case 1 '奇数回目 ActiveCell.Offset(, 4).Select Case 0 '偶数回目 ActiveCell.Offset(11, -4).Select End Select Set pic = Nothing Next i ' 終了 Application.ScreenUpdating = True MsgBox i - 1 & "枚の画像を挿入しました", vbInformation End Sub

エクセル　ルーチンマクロ

以前コピー・貼り付けを停止させる為に、下記マクロを参照させて頂いたのですが、 '--------------------------------------------------------------- Sub DisableCommandButtons(Cmd_bln As Boolean) 'コピー・貼り付けを停止させるサブルーチン・マクロ　Dim cmd As Variant 　Dim Cmdb As Object 　Dim CmdNames As Variant 　CmdNames = Array("Worksheet Menu Bar", "Cell", "Column", "Row") 　'ショートカットのインスタンス　If Cmd_bln = False Then 　　Application.OnKey "^c", "" 　　Application.OnKey "^v", "" 　　Application.OnKey "^x", "" 　Else 　　Application.OnKey "^c" 　　Application.OnKey "^v" 　　Application.OnKey "^x" 　End If 　'コマンドボタンのEnable 　For Each cmd In CmdNames 　If cmd = "Worksheet Menu Bar" Then 　　With Application.CommandBars(cmd).Controls(2) 　　 .Controls(3).Enabled = Cmd_bln 　　 .Controls(4).Enabled = Cmd_bln 　　 .Controls(5).Enabled = Cmd_bln 　　End With 　Else 　　With Application.CommandBars(cmd) 　　　.FindControl(, 19).Enabled = Cmd_bln 'Copy 　　　.FindControl(, 22).Enabled = Cmd_bln 'Paste 　　　.FindControl(, 21).Enabled = Cmd_bln 'Cut 　　End With 　End If 　Next cmd End Sub '--------------------------------------------------------------- このマクロを実行した所、コンテキストメニュー及びショートカットキーのコピー、貼付が無効になりました。 EnableCommandButtons　というマクロを別に作りショートカットのインスタンスの　If Cmd_bln = False Then　を　If Cmd_bln = True Then　に書き換えて、実行した所、ショートカットキーは有効になったのですがコンテキストメニューのコピー、貼付を有効にするやり方がわかりません。以前、同じ質問させていただき、ご回答頂いたのですが、別のPCでは、その方法でもダメなことが分かりました。 OSはXP Pro エクセルはは2003ですどなたか、助けていただけないでしょうか？よろしくお願い致します。

Excelの画像一括挿入マクロを改良したい

以下の質問の回答者さんの頂戴し少し改変して、マクロでExcelの画像を一括挿入しています。 https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12139845762 貼り付けるセルが一列に並び画像を連続して下に貼り付けるだけであればこちらのマクロで大丈夫なのですが、貼り付けるセルが2列3行になり、 1番目の写真　　2番目の写真 3番目の写真　　4番目の写真 5番目の写真　　6番目の写真という風に貼り付けたいときにどうしたらよいのかがわかりません。 ActiveCell.Offset(21).Select の所で、セルの行が21下がって貼り付けられるということはわかるのですが… 使っているExcelファイルはいわゆるセルが方眼紙のようになっており、15行19列のセルを結合してそこに写真を貼り付けています。 1番目の写真を貼り付けた後に2列移動して貼り付けたいです。ご教授いただければ幸いです。使用しているマクロ↓ Sub ShpAdTest() Dim FNames As Variant, myShp As Shape Dim Fn As String, i As Long FNames = Application.GetOpenFilename( _ filefilter:="Image(*.jpg;*.gif;*.bmp;*.png),*.jpg;*.gif;*.bmp;*.png", _ Title:="図の挿入(複数選択可）", _ MultiSelect:=True) If Not IsArray(FNames) Then Exit Sub Call BubbleSort_Str(FNames, True, vbTextCompare) Application.ScreenUpdating = False For i = LBound(FNames) To UBound(FNames) PasteShp (FNames(i)) With ActiveSheet.Shapes(ActiveSheet.Shapes.Count) .LockAspectRatio = msoTrue .Placement = xlMove .DrawingObject.PrintObject = True .Height = ActiveCell.MergeArea.Height If .Width > ActiveCell.MergeArea.Width Then .Width = ActiveCell.MergeArea.Width End If .Top = ActiveCell.MergeArea.Top + (ActiveCell.MergeArea.Height - .Height) / 2 .Left = ActiveCell.MergeArea.Left + (ActiveCell.MergeArea.Width - .Width) / 2 End With ActiveCell.Offset(21).Select Next Call ShpCutPaste Application.ScreenUpdating = True End Sub Sub PasteShp(fname As Variant) Dim Shp As Shape Set Shp = ActiveSheet.Shapes.AddPicture( _ filename:=fname, _ linktofile:=False, savewithdocument:=True, _ Left:=Selection.Left, Top:=Selection.Top, _ Width:=0, Height:=0) Shp.ScaleHeight 1!, msoTrue Shp.ScaleWidth 1!, msoTrue Set Shp = Nothing End Sub Private Sub BubbleSort_Str( _ ByRef Source As Variant, _ Optional ByVal SortAsc As Boolean = True, _ Optional ByVal Compare As VbCompareMethod = vbTextCompare) If Not IsArray(Source) Then Exit Sub Dim i As Long, j As Long Dim vntTmp As Variant For i = LBound(Source) To UBound(Source) - 1 For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1 If StrComp(Source(IIf(SortAsc, j, j + 1)), _ Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then vntTmp = Source(j) Source(j) = Source(j + 1) Source(j + 1) = vntTmp End If Next j Next i End Sub ' ↓ 画像のリンク解除と画像ファイルサイズの低減 Private Sub ShpCutPaste() Dim Shp As Shape, Nm As String Dim x As Double, y As Double Application.ScreenUpdating = False For Each Shp In ActiveSheet.Shapes With Shp x = .Left y = .Top Nm = .Name .Cut End With ActiveSheet.PasteSpecial Format:="図 (JPEG)", _ Link:=False, DisplayAsIcon:=False With Selection .Left = x .Top = y .Name = Nm End With Application.CutCopyMode = False Next Application.ScreenUpdating = True End Sub

エクセル　マクロ　FIND

いつも回答して頂き、心から感謝しています。 FINDで特定セルを探し出し、そこを起点にコピーする領域を設定しようかなと考えています。で、FINDの部分で早くも分からなくなったので質問します。下記のようなマクロを記述しましたが、FINDの記述の箇所でエラーが発生してしまいます。何が悪いのかさっぱり分からないので、どなたか教えて下さい。エラー名：実行時エラー13 　　　　　　型が一致しません。 Sub 作業状態の部分を作業名別に各シートに貼り付ける() Dim b1 As Variant With Worksheets("書面") Set b1 = .Columns("B").Find("作業状態", xlValues, xlWhole, xlByColumns, xlNext) b1.Select End With End Sub

Excel VBAで別ブックのマクロから配列を取る

Excel VBAで別ブックのマクロで計算した結果を配列で渡したいのですが、上手い方法が見つかりません。同じブック内であれば、 Function GetAry(Imax As Integer, ByRef MyAry As Variant) as Boolean のような関数を作れば、GetAry = True の時に返値の MyAry が有効であるという判断ができますが、この関数を別ブックから使う場合は、参照渡しができません。これはVBAの仕様なので仕方ないとして、以下のようなマクロを組んでみました。 '------------------------------------------------------- ' Book1.xlsm（呼び出される側） '------------------------------------------------------- Function MyAry(Imax As Integer) As Variant Dim i As Integer Dim SubAry() As Variant If Imax > 10 Then MyAry = False Else For i = 1 To Imax ReDim Preserve SubAry(i) SubAry(i) = i Next MyAry = SubAry End If End Function '------------------------------------------------------- ' Book2.xlsm（呼び出す側） '------------------------------------------------------- Sub GetMyAry() Dim DataAry As Variant Dim Imax As Integer Imax = 11 DataAry = Application.Run("Book1!MyAry", Imax) If DataAry <> False Then MsgBox UBound(DataAry) Else MsgBox DataAry End If End Sub '------------------------------------------------------- Imax = 11 であれば、メッセージボックスに False が表示されますが、Imax = 10 だと当然ですが「型が一致しません」というエラーになります。エラートラップで誤魔化そうかとも思ったのですが、もっとスマートな方法がないでしょうか。よろしくお願いします。

セル解除後、各行に値をコピーし結合するマクロ

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)にて処理を行いました。困っているのは、上記のマクロを実行すると、最初の行のみ結合できないということ。もうひとつが、セル結合をしない時に値を左端にコピーすると、文字が自動縮小されてしまいます。縮小しないようにするには、どのような処理を入れたら良いでしょうか？お力添え頂けますと幸いです。よろしくおねがいします。

Windows7, MSWord2007 でマクロを使用しています。以

Windows7, MSWord2007 でマクロを使用しています。以前うまく行っていたのに今日はエラーで止まります。記入した文字を日本字はMS明朝10.5PT, 半角アルファベットはTimesNewRomanPT12 に統一するマクロです。 [検索する文字列]に指定したパターンマッチングが正しくありません、と表示されます。他人からいただいたマクロなので自分で直せません。ご援助いただければと存じます。止まった行： .Execute Replace:=wdReplaceAll マクロ全文： Sub SelectedFontChangedMSMincho10_5TimesNewRoman12() Dim myRng As Range With ActiveDocument Set myRng = .Range(Selection.Range.Start, .Range.End) End With With myRng.Font .NameFarEast = "ＭＳ明朝" .NameAscii = "Times New Roman" .NameOther = "Times New Roman" .Size = 10.5 End With With myRng.Find .ClearFormatting .Text = "[0-9A-Za-z,.\\\!\?""'/$\%\&\#\=\-\+\<\>]{1,}" '半角スペース～チルダ .Forward = True .Wrap = wdFindStop .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .MatchFuzzy = False With .Replacement .ClearFormatting .Text = "" .Font.Size = 12 End With .Execute Replace:=wdReplaceAll End With End Sub

マクロで質問です

下記のようなマクロで現在はマクロコード内にフォルダのアドレスを書いていますがこれをダイアログを開いてフォルダを選択できるようにするにはどうすればよいでしょうか？ Sub Sample10() Call FileSearch("V:\個人\飯塚\マクロ\RawData2") End Sub Sub FileSearch(Path As String) Application.ScreenUpdating = False Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "RawData" Then Workbooks.Open fld & File, Format:=2 Range("B1:B180").Select Application.CutCopyMode = False Selection.Copy Application.DisplayAlerts = False ActiveWindow.Close Application.DisplayAlerts = True Range("f2").Select ActiveSheet.Paste ActiveSheet.Next.Activate End If Next File End Sub

エクセルのマクロコードに付いて教えて下さい。

下記のマクロコードがありますが、 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With End Sub セル位置の指定を変更する場合は、どの様に書けば良いのですか？このコードですと、セルＡ1の入力指定でなっていますがＡ1～Ａ5までとか。Ａ1、Ｂ1，Ｃ1とかにする場合はどの様に書けば良いか教えて下さい。マクロに付いて、殆ど知識が無いものですので出来れば、分かり易い説明でお願いします。宜しくお願いします。

エクセルのマクロについて

下記は、A列3行の7文字目～10文字と B列5行～文字のある最後の行までの範囲の左から1文字目～4文字に相違がある場合 MsgBox i ＆ “行目” を出す。というマクロなのですが、『B列5行～文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub

エクセルチャート操作のマクロのエラー

エクセルマクロ初心者です。グラフの縦軸をセルの値の変化に合わせて変化するよう(対照のセルはB1とB2で変化します。)下記のマクロをネット検索してモジュールに貼り付け機能するようになったのですが、シートに保護をかけると、「実行時エラーー214767259(80004005): MaximumScaleメソッドは失敗しましたAxisオブジェクトのメッセージが出て機能しません。 Worksheet_SelectionChange(ByVal Target As Range) If Range(A1) <> "" Then Call AxesSet End Sub Sub AxesSet() Dim oChart As ChartObject Set oChart = Worksheets("Sheet1").ChartObjects(1) With oChart.Chart.Axes(xlValue, xlPrimary) .MaximumScale = Worksheets("Sheet1").Range(B1) .MinimumScale = Worksheets("Sheet1").Range(B2) .DisplayUnit = xlThousands .HasDisplayUnitLabel = False .MinorTickMark = xlInside End With End Sub 対照セルの保護の問題かと思い、セルのロックを解除したり、マクロから保護を解除するなど検索してみたのですが上手くいきません。シートを保護してもマクロが機能する解決方法お教えください。

エクセルのマクロで

お世話になります下記のマクロで実行した所１００まで書式設定で保護、ロックしたいのですが b3：l3はロックするものの４行目以降はロックしませんどうしたらいいでしょうかもう１つ、このシートはいつもｃ３からはじめたいのですが If ActiveCell.Value >= "" Then の部分はどうしたらいいでしょうかよろしくおねがいいたします初心者でバカな質問ですみません Sub マクロ１() Dim i As Integer For i = 1 To 100 If ActiveCell.Value >= "" Then Range("B3:l3").Select Selection.Locked = True Selection.FormulaHidden = False End If ActiveCell.Offset(1, 0).Select Next End Sub

エクセル・マクロについて

以下のマクロはセルA1～A100にて1が表示されると音(Beep)が鳴るというものです。これを下記(1)(2)ができるように修正したいです。ご教示お願いします。 (1)音(Beep)と同時にセルA1～A100のどのセルにて1が表示されたかわかるようにしたいです。メッセージボックスなどにて表示させるにはどのように修正すれば良いですか？例.A12で1が表示されたら音が鳴りメッセージボックスにA12と表示される。続いてA55で1が表示されたら音が鳴りメッセージボックスにA55と表示される、みたいに・・・。 (2)音がBeepですが、これ以外に音を変更させることは可能ですか？音は何でもいいです。（ピーとかポロンなど） ※このマクロはシート右クリック→コードの表示で開いた所に打ち込んでいます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Variant Dim r As Range Dim c As Variant On Error GoTo EndLine i = Null Set r = Target.DirectDependents For Each c In Range("A1:A100").Cells If Not Intersect(r, c) Is Nothing Then i = c.Value Exit For End If Next c Application.EnableEvents = False If i = 1 Then Beep End If Set r = Nothing EndLine: Application.EnableEvents = True

【エクセルマクロ】画像挿入について教えてください。

Excel2010で下記マクロを実行し、画像挿入元のフォルダ名を変更・削除したり、メールに添付して送信したりすると「リンクされたイメージを表示できません。ファイルが移動または削除されたか、名前が変更された可能性があります。リンクに正しいファイル名と場所が指定されていることを確認してください。」と表示されます。 Excel2010では、Shapes.Addメソッドを使用するとリンク解除ができるとのことで、初心者ながら色々試してみたのですが、うまくいきません。マクロ初心者のため、詳しく教えていただけると大変助かります。 Private Sub Del_Btn_Click() 指定セル範囲 = "C18:K500" With ActiveSheet Set セル範囲 = .Range(指定セル範囲) For Each 図形 In .Shapes If 図形.Type = msoPicture Then Set 共有セル範囲 _ = Intersect(Range(図形.TopLeftCell, 図形.BottomRightCell), セル範囲) If Not (共有セル範囲 Is Nothing) Then 図形.Delete End If End If Next End With End Sub Private Sub Ins_Btn_Click() Dim fName As Variant Dim i As Long Dim j As Integer Dim k As Integer Dim Pict As Picture Const z1 As Long = 246 'サイズ指定 Const z2 As Long = 184 'サイズ指定 Dim z3 As Long '上位置 z3 = 306 k = 1 fName = Application.GetOpenFilename("JPGファイル, *.jpg", MultiSelect:=True) If IsArray(fName) Then Application.ScreenUpdating = False '配列に格納されたファイル名をソート BubbleSort fName, True 'If UBound(fName) >= 19 Then ' j = 19 ' Else j = UBound(fName) 'End If For i = 1 To j Set Pict = ActiveSheet.Pictures.Insert(fName(i)) If i Mod 6 = 5 Then z3 = z3 + 18.5 - k k = k + 0.5 End If If i Mod 2 = 1 Then With Pict .Width = z1 '横型 .Height = z2 '縦型 .Top = z3 + 146.5 * (i - 1) '上位置 .Left = 83 '左位置 .Locked = False ico = ico + z1 + 10 '間隔指定 End With Else With Pict .Width = z1 '横型 .Height = z2 '縦型 .Top = z3 + 146.5 * (i - 2) '上位置 .Left = 350 '左位置 .Locked = False ico = ico + z1 + 10 '間隔指定 End With End If ActiveCell.Offset(2, 0).Activate Application.StatusBar = "処理中：" & i & "/" & UBound(fName) & "枚目" Next i End If With Application .StatusBar = False .ScreenUpdating = True End With Set Pict = Nothing If i > 0 Then MsgBox j & "枚の画像を挿入しました", vbInformation End If End Sub '値の入替え Public Sub Swap(ByRef Dat1 As Variant, ByRef Dat2 As Variant) Dim varBuf As Variant varBuf = Dat1 Dat1 = Dat2 Dat2 = varBuf End Sub '配列のバブルソート Public Sub BubbleSort(ByRef aryDat As Variant, _ Optional ByVal SortAsc As Boolean = True) Dim i As Long Dim j As Long For i = LBound(aryDat) To UBound(aryDat) - 1 For j = LBound(aryDat) To LBound(aryDat) + UBound(aryDat) - i - 1 If aryDat(IIf(SortAsc, j, j + 1)) > aryDat(IIf(SortAsc, j + 1, j)) Then Call Swap(aryDat(j), aryDat(j + 1)) End If Next j Next i End Sub どうぞよろしくお願いいたします。

エクセルマクロでテキストファイルを貼り付ける方法

エクセルのマクロ

質問者が選んだベストアンサー

お礼 2013/04/03 15:53

関連するQ&A

エクセルマクロ

エクセル　マクロ

エクセルのマクロについて

エクセル　マクロ　初心者です

Excelマクロのオフセットについて

このマクロの説明をお願いします

画像をエクセルに貼り付けるマクロ

エクセル　ルーチンマクロ

Excelの画像一括挿入マクロを改良したい

エクセル　マクロ　FIND

Excel VBAで別ブックのマクロから配列を取る

セル解除後、各行に値をコピーし結合するマクロ

Windows7, MSWord2007 でマクロを使用しています。以

マクロで質問です

エクセルのマクロコードに付いて教えて下さい。

エクセルのマクロについて

エクセルチャート操作のマクロのエラー

エクセルのマクロで

エクセル・マクロについて

【エクセルマクロ】画像挿入について教えてください。

注目のQ&A

カテゴリ

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

専門家に質問してみよう

エクセルマクロでテキストファイルを貼り付ける方法

エクセルのマクロ

質問者が選んだベストアンサー

お礼 2013/04/03 15:53

関連するQ&A

エクセルマクロ

エクセル マクロ

エクセルのマクロについて

エクセル マクロ 初心者です

Excelマクロのオフセットについて

このマクロの説明をお願いします

画像をエクセルに貼り付けるマクロ

エクセル ルーチンマクロ

Excelの画像一括挿入マクロを改良したい

エクセル マクロ FIND

Excel VBAで別ブックのマクロから配列を取る

セル解除後、各行に値をコピーし結合するマクロ

Windows7, MSWord2007 でマクロを使用しています。以

マクロで質問です

エクセルのマクロコードに付いて教えて下さい。

エクセルのマクロについて

エクセルチャート操作のマクロのエラー

エクセルのマクロで

エクセル・マクロについて

【エクセルマクロ】画像挿入について教えてください。

注目のQ&A

カテゴリ

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

専門家に質問してみよう

エクセル　マクロ

エクセル　マクロ　初心者です

エクセル　ルーチンマクロ

エクセル　マクロ　FIND